What is the fastest way to count square-free words?

## Background A word is a string of letters in an alphabet. A square-free word has no adjacent repeating substring. For example, (in the ternary alphabet of {0,1,2}) the words 00, 012121, and 0212012021 are all not square-free because they contain repeated subwords, but a word like 1201021 or 0102012021 is square-free. Here is code to test if a string over the alphabet {0,1,2} is square-free, but it is too slow:               ReverseWord[w_String] :=             StringReverse[w];     PermuteWord[w_String] :=             StringReplace[w, {"0" -> "1", "1" -> "2", "2" -> "0"}];     SubWords[w_String, len_Integer] :=             Module[{i}, Union[Table[StringTake[w, {i, i + len - 1}],            {i, StringLength[w] - len + 1}]]];     NoSquare[w_String] /; Mod[StringLength[w], 2] == 0 :=             (StringTake[#, StringLength[#]/2] =!=StringTake[#, -StringLength[#]/2]) &[w];     SquareFree[w_String] :=             Apply[And, Table[Apply[And, Map[NoSquare, SubWords[w, k]]],                              {k, 2, StringLength[w], 2}]];          SquareFree["0101"] (* returns False *)     SquareFree["0102012021"] (* returns True *)      I'm sure there are some wizards out there that knows the fastest way to do this! Here is a big squarefree word to test your fast functions on:               benchmark = Uncompress@"1:eJzt0sEJgDAQRNGUoh3sbinagQ3Y/\     03ISYIQQoSvzJ5UIknm7azHue1lKcXcws2jPuP2bvUrHtdj8P92vd3n7fN7+3/9/rPnz/\     rQ9//7/Gl/Oj/dH9qf9sv5a/vT+en+0P60X85f25/OT/dH3Z/OT/dH3Z/OT/\     eH9qf9cv7a/nR+uj+0P+2X89f2p/PT/aH9ab+cv7Y/nZ/uj7o/nZ/uj7r/\     wP0uYjwiEQ==";      ## Problem The ultimate way to determine square-freeness of words is to enumerate them! So the real problem is to generate all ternary squarefree words of length n efficiently. Here was my original implementation: the function ExtendSquareFreeQ[w] checks if word w is squarefree assuming that StringTake[w, 1;;-2] is squarefree. Then, starting from the list AllSquareFree4, we build up the next AllSquareFree5, and so forth...               iExtendSquareFreeQ = Compile[{{str, _Integer, 1}},            Module[{sl = Length[str]/2 // Floor, i},               For[i = 2, i <= sl, i++,                  If[Take[str, {-2 i, -(i + 1)}] === Take[str, {-i, -1}],                      Return[False]]                  ];                 True                 ], CompilationTarget -> "C", RuntimeOptions -> "Speed",                  RuntimeAttributes -> {Listable}, Parallelization -> True                ];      ExtendSquareFreeQ[str_String] := iExtendSquareFreeQ[ToCharacterCode[str]];       DistributeDefinitions[ExtendSquareFreeQ];           ExtendAllSquareFree[list_] := Module[             {cand, sfcand},              cand = Flatten @ Map[                 Function[w,                     Function[s, StringJoin[w, s]] /@                      Complement[{"0", "1", "2"}, {StringTake[w, -1]}]                     ],                     list               ];               sfcand = ParallelMap[ExtendSquareFreeQ, cand];               Pick[cand, sfcand]           ];          AllSquareFree2 = {"01"};     temp = AllSquareFree2;     byteCounts = {};     times = {};     Monitor[Table[       {time, temp} = AbsoluteTiming[ExtendAllSquareFree[temp]];       temps = Compress@temp;       AppendTo[times, time];       AppendTo[byteCounts, ByteCount[temps]/1000000];, {n, 2, 111}],       ListPlot[{times, byteCounts}, Mesh -> Full,        PlotRange -> {Automatic, All}, Filling -> Axis,       AxesLabel -> {"n", None}, InterpolationOrder -> 2, Joined -> True,        PlotLabel -> Text@Row[{           "n: " <> ToString[n],           "count: " <> ToString[Length[temp]*6],           "time: " <> ToString[N[time, 2]] <> " s",           "mem: " <> ToString[N[byteCounts // Last, 2]] <> " mB"},           " | "]]]       But both the time and memory complexities are way too high for $n>60$. Is there a much more efficient way to perform this search? Perhaps storing the lists of strings in special data structures and traverse them in fancy ways? I'll take any solutions of linear or quadratic complexity, or that can reach $n >= 111.$ **The main difficulty is that when storing all the words of length 63 _Mathematica_ runs out of memory!** I was hoping for some brilliant optimized data structures, but I guess I might just have to use a tree...


Fitting data using a series of Sin and Cos

I have the following data representing the normal displacement caused by a normal load applied at the middle cross section of a cylinder: ![enter image description here](http://i.stack.imgur.com/QZEzP.png) I've made the data available here. I am trying to fit using the function: $$ w=\sum_{i=1}^{n} A_{i}\cdot sin(j\theta)+B_{i}\cdot cos(j\theta) $$ where $A_{i}$ and $B_{i}$ are the unknown amplitudes to be found. I am using `LeastSquares` for this task:               theta = data[[All, 1]];     w = data[[All, 2]];          num = Dimensions[theta][[1]];     n = 5;          m = Table[        Flatten[Table[{Sin[i1*theta[[i2]]], 0}, {i1, 1, n}]] +          Flatten[Table[{0, Cos[i1*theta[[i2]]]}, {i1, 1, n}]], {i2, 1,          num}];     x = LeastSquares[m, w];          f[t_] := Total[Flatten[Table[{Sin[i*t], Cos[i*t]}, {i, 1, n}]].x]     Plot[f[t], {t, -Pi, Pi}, PlotRange -> {{-1, 1}, {0, 0.030}}]      But it is resulting in an empty graphic: ![enter image description here](http://i.stack.imgur.com/ULsc8.png) Does anyone know what I am doing wrong?


Generating an ordered list of pairs of elements from ordered lists

I have a pair of ordered lists. I want to generate a new ordered list (using the same ordering) of length n by applying a binary operator to pairs of elements, one from each list, along with the index of each list's elements. For example, if I have two lists of real numbers in increasing order (sorted via Less),               l1 = {5.7832, 30.4713, 74.887, 139.04, 222.932, 326.563}          l2 = {3.481, 9.2816, 15.7112, 27.8226, 45.0379, 67.222, 94.3526}      and the binary operator is Plus, then if I ask for 5 elements, the result would be               {{9.26417, 1, 1}, {15.0647, 1, 2}, {21.4944, 1, 3}, {33.6058, 1, 4}, {33.9522, 2, 1}}      I've written code that achieves this but I'm looking for the most elegant, efficient, and general solution that would work with arbitrary lists and binary operators.


Is it possible to separately call the default value of a variable which isn't at the end of the sequence?

After reading this post I recalled an old question I once met. We know that we can set default values for variables of a function:               f[u_: 1, v_: 2, w_: 3] := u^2 + v^3 + w^4      We can use the default values like this:               f[]      > 90 like this:               f[u]      > 89 + u^2 and like this:               f[u, v]      > 81 + u^2 + v^3 However, what if I want to call the default value of a variable not at end separately? Something like               f[, v, w]      only gives > Null^2 + v^3 + w^4 while what I want to see is > 1 + v^3 + w^4 Of course it's easy to circumvent, but I still wonder if there's a more straight forward solution.


How can I influence the elements plotted in a BubbleChart depending on the tuple plotted?

In a BubbleChart, how can influence the elements plotted depending on a value in the tuple plotted? I want to create a BubbleChart from the following data:                lines = {{1, 10, 2}, {2, 15, 1}, {3, 27, 4}, {4, 35, 2}}      but instead of the bubbles, I want to draw a line as long as `z`.


How to force Dt[ ] to recognize dependencies

I want to differentiate a function `f[]` for which I don't have a specific expression. `f[]` depends on `x` and `y` and has parameters k1 and k2 in it. `x` and `y` depend on `t`,and not on `k1` nor `k2`. So when I use the total derivation operator `Dt[f, t]`, only `x` and `y` should be differentiated. But how can I say Mathematica that k1 and k2 are constant, without assigning values to them?


PlotRangePadding that's a fixed fraction of a plot's longest dimension

I am trying to produce plots of a region which can alternately become very long or very tall, and I would like to have some padding around it which is uniformly thick in both the horizontal and vertical directions. However, I'm having some trouble getting the correct settings for `PlotRangePadding` to achieve this. More specifically, I'm trying to get a padding between my plot and the surrounding Frame that is (say) 10% of the _longest_ dimension of my plot. This is what I might naïvely expect of a single setting fed to the option, which is meant to produce "the same padding in all directions", but giving it the corresponding setting,               Graphics[{Pink, Rectangle[{0, 0}, {1, 0.1}]},          PlotRangePadding -> Scaled[0.1], Frame -> True]      produces a padding of 10% of the relevant dimension in each direction. This is not very visually pleasing, as the long coordinate has too much padding and the short coordinate has too little padding: ![](http://i.stack.imgur.com/r1XzX.png) Is there a way to automatically achieve such a scaled uniform padding? Note that manually setting different settings for the different directions, such as `PlotRangePadding -> {Scaled[0.02], Scaled[0.2]}` is not an option, as my plots are dynamically generated, and may change from 'long' to 'square' to 'tall'. The coordinate ranges can also change dramatically from the few tenths to the few hundreds in each direction, so a static padding will not work.


How can I get the general term of this recurrence equations?

Following is the recurrence relation:               a[1] = 1;     a[n_] := a[n - a[n - 1]] + 1     Array[a, 28]      I tried to use `RSolve`, but it doesn't gives a correct answer.               Clear[a]     RSolve[{a[n] == a[n - a[n - 1]] + 1}, a[n], a]


Problem using NDSolve

This might be some simple mistake, but I am running out of ideas. I am trying to fit an ODE system to some data. This error keeps appearing > NDSolve::nlnum: "The function value {0.299812 - 0.000145006 a, 0.001 > -0.000145006 a} is not a list of numbers with dimensions {2} at {t, sa[t], > st[t]} = {0.000483352, 0.000145006, 1.}." The code is adapted to How do I find the best parameter to fit my data if the model is a interpolating function? :               data = {      {0.`, 34.84229229652888`}, {3.7448333333333332`, 29.004820470134124`},       {7.4896666666666665`, 22.762395022844483`}, {11.2345`, 16.82225654209896`}      }          Clear[kss, kdm, at, gof];          kss = 0.001; kdm = 0; at = 0.3;          eqs[kas_, k2s_, at_] := {       st'[t] == kss - k2s sa[t] - kdm st[t],       sa'[t] == kas (at - sa[t]) (st[t] - sa[t]) - k2s sa[t],       sa[0] == 0, st[0] == 1       }          gof[kas_, k2s_, at_] :=      (       soltry = st /. NDSolve[eqs[kas, k2s, at], {st, sa}, {t, 0, 100}] // First;       (soltry /@ data[[All, 1]]) - data[[All, 2]]/data[[1, 2]] // #.# &     )          NMinimize[{gof[1, a, 0.3], 0 < a < 5}, a]


In the documentation, it states that > The Laplace transform of a function $f(t)$ is defined to be $\int_0^{\infty > } f(t) e^{-s t} \, \mathrm{d}t$. But why can _Mathematica_ not get the Laplace transform of $\frac{1-\cos (t)}{t}$?               $Assumptions=s>0;          LaplaceTransform[(1-Cos[t])/t,t,s]     (* EulerGamma+LaplaceTransform[1/t,t,s]+1/2 Log[1+s^2] *)      and the integral does converge               Integrate[(1-Cos[t])/t Exp[-s t],{t,0,∞}]     (* 1/2 Log[1+1/s^2] *)      ?


FindMaximum of loglikelihood in Gaussian Process

I am trying to implement a Gaussian Process and have problems to maximize the loglikelihood because the function consists of a determinant of a matrix that is dependent of 2 variables and the product of the inverse of the matrix with 2 vectors. The full problem I am working on has 6 instead of 2 variables but I already fail with the 2. Do I have to use a different representation of the loglikehood? Maybe work with the partial derivatives of the loglikelihood with respect to the hyperparamters {h0,h1}? I think there are implementations of a GP in Matlab but not for Mathematica.                gpdata = {{-1.5, -1.8}, {-1., -1.2}, {-0.75, -0.4}, {-0.4,      0.1}, {-0.25, 0.5}, {0., 0.8}};          kernelfunction[i_, j_, h0_, h1_] :=       h0*h0*Exp[-(gpdata[[i, 1]] - gpdata[[j, 1]])^2/(2*h1^2)] +       KroneckerDelta[i, j]*0.09;          covariancematrix[h0_, h1_] =      ParallelTable[kernelfunction[i, j, h0, h1], {i, 1, 6}, {j, 1, 6}];          loglikelihood[h0_, h1_] := -0.5*     gpdata[[All, 2]].Inverse[covariancematrix[h0, h1]].gpdata[[All, 2]] -      0.5*Log[Det[covariancematrix[h0, h1]]] - 3*Log[2*Pi];          FindMaximum[loglikelihood[a, b], {{a, 1}, {b, 1.1}}]


Given x[u,v], y[u,v], and f[x,y] how do I find D[f,x] in terms of u,v?

I have two functions _x = x(u,v)_ and _y = y(u,v)_. The chain rule says that for a function f(x,y), _df/dx = df/du du/dx + df/dv dv/dx_ , and similarly _df/dy = df/du du/dy + df/dv dv/dy_. How do I get _Mathematica_ to give me _df/dx_ in terms of _u_ , _v_ , and _df/du_ , _df/dv_? I should point out that _x(u,v)_ and _y(u,v)_ are **not** easily invertible to give _u(x,y)_ and _v(x,y)_.


Numerical integration with OwnValues

Say I have a symbol with an `OwnValue`               a = y      And we define an integration like this               f[y_?NumericQ] := NIntegrate[a*z*y, {z, 0, 1}]      Then calling `f[1]` results in an error, probably because of the `HoldAll` attribute of `NIntegrate`. Using `Evaluate[a]` does not help. How can an integration like this be done correctly?


Menu bars on Palette windows don't work properly -- any workarounds?

After getting help from Rojo with Menu commands on Palettes and other windows without menu bars? I was able to create a Palette with a menu bar by:   1. Selecting the Palette and opening the **Option Inspector** with `Ctrl`+`Shift`+`O`   2. Setting `Editable -> True` and `WindowElements -> {"MenuBar"}` However the bar seems very glitchy:   * Sometimes it appears to be entirely disabled   * Then when I drag the window around or change focus a time or two it comes to life    * Then later becomes disabled again   * Sometimes it appears to be enabled (not grayed out) but I can't open any of the menus Further the menu commands themselves, when available, don't work right:   * Despite confirming that `Saveable -> True` the **Save** and **Save As...** items are disabled   * The **Palettes** > **Generate Notebook from Palette** item is also disabled; if not usable _here_ then where? Though I could not **Save** the Palette (Notebook) I captured its expression with `NotebookGet`:               Notebook[{Cell[        BoxData[ButtonBox["\"Beep!\"", Appearance -> Automatic, ButtonFunction :> Beep[],           Evaluator -> Automatic, Method -> "Preemptive"]], "NotebookDefault"]},       Editable -> True, WindowSize -> {700, 100},       WindowMargins -> {{Automatic, 51}, {266, Automatic}}, WindowFrame -> "Palette",       WindowElements -> {"MenuBar"}, WindowFrameElements -> {"CloseBox", "MinimizeBox"},       FrontEndVersion -> "10.0 for Microsoft Windows (64-bit) (July 1, 2014)",       StyleDefinitions -> "Palette.nb"]       ### Are other Windows users able to reproduce the series of bugs I described above? ### Has anyone figured out how to work with Palettes in Version 10 under Windows?


How do I split up a curve into segments of equal length?

I have a curve that is defined as f[x] and what I'm attempting to do is to divide the curve into equal straight lengths for a number of segments of my choosing that I've defined as nSeg. I've created a sheet that can work through and determine the (x,y) co- ordinates for each segment, but I'm having to manually manipulate the equations to create a single equation for _Mathematica_ to find the roots for. The straight length of the curve I've defined as;               chordL = Table[                 Sqrt[(Subscript[x, i + 1] - Subscript[x,i])^2 +                       (f[Subscript[x, i + 1]] - f[Subscript[x, i]])^2                 ], {i, 1, nSeg}              ]      This creates a list of equations for the length of each segment. What I would like to do is make each part of the list equal to each other so that I can feed this into `FindRoot` later in the sheet so that if I decide to change the number of segments from 8 to 10, the sheet can be refreshed from a single variable.               FindRoot[*combined equations*, {Subscript[x, 2], 1}, {Subscript[x, 3], 2}]      The above is an example of how I'm currently doing it and it means I've a sheet for each value of nSeg, which isn't a smart way to work and I'm manually defining which variables to solve independently of the value of nSeg, even though the first and last co-ordinate will always be known. I'm quite new to Mathematica and would really appreciate a nudge in the right direction to combine the equations in the first part to give the equations to solve in `FindRoot` (which I'm using instead of `Solve` for speed) in a flexible manner, and also increment the number of variables to solve given that x1 will always be 0 and x(nSeg+1) will always be known too as these are the start and end points of the curve which are defined by the input at the beginning of the sheet.


How to use NyquistPlot without having a transfer function model?

Could anyone tell me how to use `NyquistPlot` with a first argument that is not a transfer function model? The expression I'd like to pass to `NyquistPlot` is `Exp[z]Cos[z]`.


Using DynamicWrapper with multiple Dynamics with different TrackedSymbols

I have two variables A and B that are linked such that changes to one causes the other to be updated to the same value. However at each change I'd also like to know which variable cause the update to happen. I've implemented this functionality using two Dynamic expressions.                label = "Initial";      A = 0; B = 0;           {Dynamic[(If[B != A, (B = A); label = "A"]);, TrackedSymbols :> {A}],        Dynamic[(If[A != B, (A = B); label = "B"]);, TrackedSymbols :> {B}]}           Dynamic[{label, A, B}]      Row[{Button["++A", ++A],Button["++B", ++B]}]       I would like to hide the output of these dynamic expressions in a similar fashion to `DynamicWrapper`, however there seems to be a problem in that `DynamicWrapper` doesn't respect `TrackedSymbols`, and of course only allows a single expression to be tied to an object. The mentioned problem with `DynamicWrapper` is present if the `Dynamic` elements are simply substituted for Dynamic wrappers thus this instead. This, however, is not the main problem, since it seems impossible to have a single `DynamicWrapper` with               DynamicWrapper["Something",     {Dynamic[(If[B != A, (B = A); label = "A"]);, TrackedSymbols :> {A}],      , Dynamic[(If[A != B, (A = B); label = "B"]), TrackedSymbols :> {B}]}     ]      It seems that it will reevaluate the entire expression no matter which symbol changes, however even using multiple wrappers does not work, so the following is not what I want, since I still need multiple elements associated with each event, however I would expect that it worked if it did indeed respect the `TrackedSymbols`:               DynamicWrapper["Something", (Print["A event"];If[B != A, (B = A); label = "A"]);, TrackedSymbols :> {A}]     DynamicWrapper["Something", (Print["B event"];If[A != B, (A = B); label = "B"]),  TrackedSymbols :> {B}]      This to the original working example with Print statements inserted the difference is that the `DynamicWrapper` calls the A event first no matter which variable changed, which seems wrong since changing B should call B event first, then call A event. This seems consistent with `DynamicWrapper` not respecting `TrackedSymbols`, and thus triggering both events on the change, and then adding an additional triggering of B when B=A is set in the A event. **Clarification** There seems to be some confusion, so let me clarify I do not just want an invisible object that when in sight will run the events, ideally I would like to have something akin to:                DynamicWrapper[      Dynamic[{label, A, B}],      {Dynamic[(If[B != A, (B = A); label = "A"]);, TrackedSymbols :> {A}],        Dynamic[(If[A != B, (A = B); label = "B"]);, TrackedSymbols :> {B}]}      ]      Which displays as the expression but keeps the dynamic evaluations "in scope" if it is visible.


Variable partitioning of the data in the form of "list of lists"

I am looking for a way for variable partitioning of the data in the form of a "list of lists" for interpolating the imported data from excel. The data looks like:               data = {       {{5., 9.53333, 0.057735}, {5., 19.3333, 0.057735}, {5.,29.2667, 0.057735},        {5., 39.0667, 0.11547}, {5., 49., 0.}, {10., 11., 0.}, {10., 22.4, 4.35117*10^-15},         {10., 33.6667, 0.057735}, {10., 45.1, 0.}, {10., 56.3333, 0.11547},        {15., 12.4667, 0.057735}, {15., 25.2667, 0.057735}, {15., 38., 0.1},         {15., 50.9333, 0.057735}, {15., 63.7667, 0.057735}, {20., 13.8333, 0.057735},         {20., 28.1, 0.1}, {20., 42.3667, 0.057735}, {20., 56.5333, 0.057735},         {20., 70.8667, 0.152753}}            }      Now I want to interpolated this data using `Interpolation` function but the problem is that `Interpolation` needs the data in the form:               {{5., 9.53333}, 0.057735}, {{5., 19.3333}, 0.057735},...}      Without bothering about this form, if I try to Interpolate using command:               f = Interpolation[data[[1]], InterpolationOrder -> 2]      it interpolates but produces a warning as well: > >      Interpolation::udeg: Interpolation on unstructured grids is currently > only >      supported for InterpolationOrder -> 1 or InterpolationOrder -> All. >      Order will be reduced to 1. >   I would have been happy if the 3D plot of `f[x,y]` would have been a bit better than this (I hate spikes in the plot): ![3D plot when InterpolationOrder is 1](http://i.stack.imgur.com/A7j2M.jpg) Overall, I think that the problem can be resolved by supplying "structured grids" to the `Interpolation` command and that's where I have got stuck. I need to arrange the data as it is required in the `Interpolation` command. I have also checked Mr Wizard's solution for [dynamic partitioning](Partitioning with varying partition size"list manipulation - Partitioning with varying partition size") but it dose not work (or I must say - I could not make it work) in this case. I have got a feeling that some modification in that will do the job but I do not know the workaround for that.   So the question is how to do that?


Using block or module to free cache

I'm writing some code at the moment that schematically looks like: * * * ( _set initial conditions for some differential equation for given parameters (M,R,...)_ )               M=1;     R=1:       ( _NDSolve differential equation taking ~10mins or more to give solution dependent on some more paramaters (w,l,m); defining a memoized function_ )               Phi[w_?NumericQ,l_?IntegerQ,m_?IntegerQ]:=Phi[w,l,m]= "Interpolated Func result of  NDSolve taking 10mins to compute"      ( _For a given parameter set (w,l,m) compute a few things, such as coefficients and the (w,l,m) term in a sum, for which numerical differentiation ND[..] is needed, hence the necessity of memoizing this Phi to speed this step up_ )               A[w,l,m]:= "some calc dependent on the Phi";     B[w,l,m]:= "some calc dependent on the Phi"     termSum[w,l,m]:= "some calc dependent on the Phi and A,B"      ( _write termSum to file_ )               PutAppend[...]      ( _clear cache of the memoized Phi[w,l,m] interp func and the other variables like A[w,l,m]_ )               Phi[1,2,3]:=.   (*unset*)      . . . ( _after the rinse now repeat for a different (w,l,m)_ )               Implemented by some 'do' or 'for' loop.      * * * Some issues I'm considering: 1) Is there a way to use `Block`/`Module` say to allow me to better handle my caching of the variables (especially the huge memory hogs like the Phi that is a very large Interpolating Function)? 2) Also if I change my initial parameters M, R etc. I have to start all over again with setting initial conditions and so forth and functions that depend. Could I use `Block`/`Module` to incorporate this? 3) Is there a way to run some kind of initialization script in Mathematica that will set my constants, run my standard definitions etc. each time I load the notebook? 4) In a later calculation I will probably use the Phi,A,B for a given (w,l,m) all over again but for different values of 'r' along the range of the interpolating function. I've thought of saving to hard memory the actual interpolating functions of a given (w,l,m) but normal `Save` leads to 200MB files, and even `DumpSave` >20MB. Anything I could do about this or do I just have to recompute?


How to position text labels automatically to not overlap other graphics elements?

I was plotting reciprocal frame projection using `Locator`s for a point to be expressed in terms of both the original basis (also specified with `Locator`s and reciprocal basis.) EDIT: Here's a stripped down example of the code (no longer matching the image)               Manipulate[DynamicModule[{f1, f2, xf, o, r, s}, o = {0, 0};       s = {0.1, 0.1};       r = Inverse[{e1, e2}]; f1 = Part[r, All, 1]; f2 = Part[r, All, 2];       xf = {x.f1, x.f2};       Graphics[{Arrow[{o, x}], Arrow[{o, xf[[1]] e1}],         Arrow[{xf[[1]] e1, xf[[1]] e1 + xf[[2]] e2}], Text["x", x + s],         Text["e1", e1 + s], Text["e2", e2 + s]}]], {{x, {4, 2}},       Locator}, {{e1, {1, 1}}, Locator}, {{e2, {1, 2}}, Locator}]      I've placed labels on some of the arrows that represent the vectors, but did this by fudging things adding in a fixed offsets (variable `s` above). ![reciprocal frame locators with problematic text labels](http://i.stack.imgur.com/4LixQ.png) The manual offsets are in some cases positioned reasonably for some of the labels (because my hardcoded offsets are implicitly related to the initial geometry of the `Locator`s). I'd like to avoid hardcoding those offsets in the hacky way that I've done. Is there a better way to automatically position those `Text` labels so that they are offset slightly (e.g. the width of a text character) from nearby graphics elements?


Multiple output cells

Is it possible to have multiple outputs from a single function? For example:               In[1]:= x+1             x+2     Out[1]= 1+x     Out[2]= 2+x      has multiple outputs, how can I acheive that in a function? I tried               In[3]:= f[x_]:=Module[{},     x+1     x+2     ]     In[4]:= f[2]     Out[4]= 6      which doesn't work.


Automatically return output using decimals instead of fractions

I have a mathematica file with an algorithm that feeds another program with data. my problem is that some times (randomly) the output is in fraction instead of decimal. The other program (java) does not read fractions, so I have to feed it with decimal numbers. One solution is to use the `N[.]` function before it output, but this is really painful procedure. Is there any setting in mathematica forcing it to return as output only decimals?


Fitting numerical model to experimental data

I have diffusion equation with the initial/boundary conditions:               eq = D[c[x, t], t] - d * D[c[x, t], {x, 2}] == 0;     ibc = {c[x, 0] == If[x != 0, 0, 1], c[0, t] == 1, Derivative[1, 0][c][0.3, t] == 0};      where 'd' is the diffusion coefficient. Also I have about 500 data points of the diffusion process (in 3D form, C(x,t)). I'd like to estimate the diffusion coefficient. I've tried to use FindFit to estimate value of the 'd' in two ways: 1)               sol1 = ParametricNDSolve[{eq, ibc}, {c[x,t]}, {x, 0, 0.3}, {t, 0, 3.5}, {d}]     fit1 = FindFit[pts, sol1[d][c[x,t], d, {x,t}]]      2) (based on the Mathematica's Documentary Center -> FindFit)               model[d_?NumberQ] := (model[d] = First[c[x,t] /. NDSolve[{eq, ibc}, {c[x,t]},{x, 0, 0.3}, {t, 0, 3.5}]]          fit2 = FindFit[pts, model[d][c[x, t]], d, {x, t}]      In both cases I get an error:               FindFit::nrlnum: The function value {-0.437097+c[c[0.05812,0.116667]],-0.5016+c[c[0.05812,0.233333]],<<47>>,-0.862967+c[c[0.06838,2.4525]],<<548>>} is not a list of real numbers with dimensions {598} at {d} = {1.}. >>      I would appreciate any help in rebuilding the code. Thanks!


Manipulating Equations

I would like to be able to manipulate algebraic equations. For example, let's say I enter `3x+5==2` I would next like to be able to manually subtract $2$ from both sides. I tried the obvious thing `%-2`, but this just returns `-2+(3x+5==2)` Is there a way to


Plot Series output?

I tried to search if similar questions existed but I have not found anything. Can someone help me with this code?               Plot[Normal[Series[Cos[x], {x, 0, 4}]], {x, 0, 3}]       I am getting an error message               General::ivar: 0.00006128571428571428` is not a valid variable. >>      I would like to plot a series expansion... Thanks in advance. Regards, Umberto PS This is a very reduced piece of the work I am working on, just to be able to reproduce the error...


Head of a MatrixForm expression?

An example in http://www- zeuthen.desy.de/theory/capp2005/Course/hahn/mathematica.pdf amounts to the following                   mat = {{1, 2}, {3,4}};         mat // MatrixForm     (* I've suppressed output *)         Head[%]     (* List *)      Why is that head `List` rather than `MatrixForm`, in view of the following?                   Head[MatrixForm[mat]]     (* MatrixForm *)


How can I make images in the cell auto-adjust to some fixed-size

There is one `auto-adjust` item in the right-click menu of image in cell. And other related items are `actual size` and `magnification`. Can we set some values for the `auto-adjust`? (the effect like `ImageResize[image,100]` by hand) The image was interted/paste in the cell. ![enter image description here](http://i.stack.imgur.com/XfkkB.png)


Mathematica 9 can't integrate this function but earlier versions could

Integrate[ ArcTan[x]/(1 + x) Log[(1 + x^2)/2], {x, -1, 1}]      I used _Mathematica 9.0.1_ on _Windows7 32bit_ , _Mathematica 9_ cannot compute this, but Mathematica 8 gives `Pi^3/96`, is this a bug?


Creating a NearestFunction that returns an index

I use `Nearest` repeatedly for large data sets. For example               pts = RandomReal[{-1, 1}, {1000, 3}];       Nearest[pts, {0, 0, 0}]      I am interested in the index of the nearest point, so I use               ind = First@Nearest[pts -> Automatic, {0, 0, 0}]      How do I create a `NearestFunction` that can return an index. Returning a point is easy               nf = Nearest[pts];       nf[{0, 0, 0}]      but there is seemingly no option to return the index?


Happy 2K prime question

This being the Q number 2K in the site, and this being the day we got the confirmation of mathematica.se graduating soon, I think a celebration question is in order. So... What is the fastest way to compute the happy prime number 2000 in Mathematica? **Edit** Here are the **Timing[ ]** results so far:                {"JM",      {5.610, 137653}}      {"Leonid",  {5.109, {12814, 137653}}}      {"wxffles", {4.11, {12814, 137653}}}      {"Rojo",    {0.765, {12814, 137653}}}      {"Rojo1",   {0.547, {12814, 137653}}}


label all vertices in polygon plot

Let's say I have the following plot `Graphics[{Opacity[0.2], Rectangle[{0, 0}, {4, 4}]}]` And I want to label all vertices on the graph to give their coordinates, in this case, `Point(0,0)` as `"P1"`, `Point(0,4)` as `"P2"`... In general, I want to write a function: `plotPolygonWithLabel[polygon_, label_]:=...` where label_ is the array like `{"P1", "P2", }` here


Manipulating sparse array elements

Suppose I have two sparse arrays               L = SparseArray[{{1, 1} -> 1, {1, 5} -> 4, {5, 1} -> 1, {5, 5} ->       2, {10, 10} -> 2, {10, 14} -> 2, {10, 18} -> 1, {14, 10} ->       2, {14, 14} -> 2, {14, 18} -> 1, {18, 10} -> -1, {18, 14} ->       1, {18, 18} -> 1, {19, 19} ->       1, {19, 23} -> -1, {19, 27} -> -1, {23, 19} -> 1, {23, 23} ->       2, {23, 27} -> 1, {27, 19} -> 1, {27, 23} -> 1, {27, 27} -> 1}];      and               R = SparseArray[{{1, 1} -> -1, {1, 5} -> 3, {5, 1} -> 1, {5, 5} ->           2, {10, 10} -> 2, {10, 14} -> 2, {10, 18} -> 1, {14, 10} ->           2, {14, 14} -> 2, {14, 18} -> -1, {18, 10} -> -2, {18, 14} ->           4, {18, 18} -> 1, {19, 19} ->           1, {19, 23} -> -1, {19, 27} -> -3, {23, 19} -> 1, {23, 23} ->           2, {23, 27} -> 1, {27, 19} -> 1, {27, 23} -> 1, {27, 27} -> 1}];      My problem is to construct another sparse matrix whose entries are coming from the above matrices with some specific properties. (Well I just need to get the `ArrayRules`, obviously). For instance, I need to get the sparse matrix `P` whose nonzero entries are union of the positive entries entries of `L` and `R`, i.e. if any position of `L` (resp. `R`) has a positive entry, `P` should also have a positive entry. Now the union of the positions can be taken easily by               Union[Cases[ArrayRules[L, (r : (_ -> x_ /; Positive[x])) -> r], Cases[ArrayRules[R, (r : (_ -> x_ /; Positive[x])) -> r]]      But here is the problem. Notice that, the entry `{1,5}->4` in the first list and `{1,5}->3` in the second list (and sometimes the opposite). If such a situation (or say collision) happens, then the position `{1,5}` of the output sparse matrix should have the maximum of the all possible values (here 4). Is it possible to write it neatly? I also need to make a sparse matrix `N`, whose non zero entries are common nonzero entries of `L` and `R`, with the caveat that for a collision, as defined above, the corresponding entry is the minimum of all possible entries. Advanced thanks for any help.


How can write a list as a formatted string to a file

I have two lists: `{a, 1, b}` and `{b, 1.3, y}` My goal is to print them to file `test.dat`, so that the content of `test.dat` looks like:               (a 1 b)     (b 1.300 y)      I want the elements of the lists in the output file to be separated by spaces. **Questions:**   1. How can I do it?   2. Is it possible to use Print command to do it? **Edit 1:** I was going along these lines:               myPrint[list_] := Print["(", Row[list, " "], ")"]     l1 = {a, 1, b};     myPrint[l1]      > (a 1 b) My problem is that I don't know how to export the results I got to a file. So this is the reason for my question 2. **Edit Final: Problem Solved** Solution by **swish** (from comments)               str = OpenWrite["test.dat"]     myPrint[list_] :=       WriteString[str, Row[{"(", Row[NumberForm[#, {4, 3}] & /@ list, " "], ")\n"}]]     l1 = {a, 1, b}     myPrint[l1]


Explicit, closed formula for recursive integral as a function of the recursive parameter

This is a follow-up of this question/answer. I'm working on a recursive integral more complicated than the one on the linked question, but this one can be used as an example. I would like to obtain a closed expression for the dependence of the integral on the dimension $d$, that is, on the recursive parameter. In other words, I want to know what the general term of the recurrence relation is. `RSolve` is not able to find it (in my example).


How do I use Greek characters in the WindowTitle option of CreateWindow?

I am trying to write some exercises in Greek using `CreateWindow`. My problem is with using Greek characters in the option `WindowTitle`. For example, with               CreateWindow[DocumentNotebook[{a}, WindowTitle -> "Ενα"]]       I get a new window with the title, `Ε\\[Nu]\\[Alpha]`, and no one can understand this title. How cam I get the proper glyphs instead of their full names?


Continuous wavelet transform with complex Morlet function

The complex Morlet function is defined as: $$Ψ(t,f_c,f_b)= \frac{1}{\sqrt[]{ \pi f_{b} } }\exp(-t^2/f_b)\exp(\jmath 2πf_ct)$$ where $f_b$ and $f_c$ are two important parameters in modifying the complex Morlet wavelet. It seems that _Mathematica_ doesn't support complex Morlet transform and Its only support real morlet function that I am not interested to use. I'm into complex wavelet function. _Mathematica_ only has Gabor transform for complex wavelets, and Gabor transform only has one parameter to be tuned.   so I need complex morlet function to run continues wavelet transform. Also I want to define $f_b$ and $f_c$ of the complex morlet function myself.   Can I make a complex Morlet wavalet transform by changing Gabor's parameter? How can I change $f_b$ and $f_c$ in it?   can I define a new wavelet exactly like the equation of complex morlet? P.S: Actually I am a _MATLAB_ user and as such I don't really know anything about the flexibility of _Mathematica_ , but the reason why I came here is that _Mathematica_ has the `InverseContinuousWaveletTransform`.


Is Mathematica v10 on the Raspberry Pi licensed for classroom use?

Now that I have v10 running on my Raspberry Pi, I'm interested in what "personal and educational use" means. As a Home user, I fully understand "personal"... but does "educational" mean that I'm free to donate a Raspberry Pi to my daughter's school and have Mathematica installed? Or is it restricted to a single person's educational use? And to all those who made this possible, my deepest gratitude! Link to the license page: http://wolfram.com/legal/agreements/wolfram-mathematica-raspberry-pi.html


NMaximize and Conditional Loop

I have developed the following code that simulates a process that decays over time and then returns to its initial state periodically. When I pass a list of random integers in the interval $(1,0)$ as arguments, the function behaves as I expect it to. However, when NMaximize calls the function, I get the following error: > NMaximize::nnum: The function value -1000 - 19 If[a[21] == 1,500, 1000] is > not a number at {a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9], > a[10], a[11], a[12], a[13], a[14], a[15], a[16], a[17], a[18], a[19], a[20]} > = {1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., > 1., 1.}. >> ` The interesting part of the error is the complaint > about`a[21]`; this variable doesn't exist unless the function is called > by`NMaximize`. The idea is that`NMaximize` will find integer, binary values > for the parameters that will maximize the return value of the function. My guess is that there is problem in how my function is being translated internally by `NMaximize`, but I am not not sure what to do at this point.               (*Assign Initial Values*)     Clear[f, i, a, vars, realconstraints, integerconstraints]     PeriodCapacityLoss = 10;     InitialCapacity = 1000;     OOSCapacity = 500;     AssymtoticCapacity = 200;     Periods = 20;     CurrentCapacity[1] = InitialCapacity;          (*Generate random series of cleaning flags*)     For[j = 1, j < Periods + 1, j++,       RecoveryFlag[j] = RandomInteger[{0, 1}];     ];          (*Function to simulate effect of capacity degredation and recovery*)     f[a_] := Module[{i},       (* Set initial condition as clean *)         CurrentCapacity[1] = InitialCapacity;       For[i = 2, i < Periods + 1, i++,         CurrentCapacity[i] =            If[a[i] == 0 && a[i - 1] == 0,              CurrentCapacity[i - 1] - PeriodCapacityLoss,              If[a[i] == 1, OOSCapacity, InitialCapacity]           ];       ];       Return[Total[Map[CurrentCapacity, Range[Periods]]]];     ];          (*Pass random cleaning flags to degredation function and plot*)     Print[f[RecoveryFlag]];          ListLinePlot[Array[CurrentCapacity, Periods]]          (* Define the integer constraints *)     vars = Array[a, Periods];     realconstraints = And @@ Map[Greater[2, #, 0]&, vars];     integerconstraints = Append[realconstraints, Element[vars, Integers]];          (*        Find the value of the recovery flag that maximizes capacity across the        time window     *)     NMaximize[{f[a], integerconstraints}, vars, Method->{"DifferentialEvolution"}]


Extracting financial indicator data from trading chart

How can the data of the directional movement index below be extracted from this chart? It seems to be embedded in some kind of dynamic module.               data = FinancialData["IBM", "OHLCV",        {{2013, 12, 31}, {2014, 3, 31}}];     chart = TradingChart[data,       {FinancialIndicator["AverageDirectionalMovementIndex", 7]},       Appearance -> "Line"]      ![enter image description here](http://i.stack.imgur.com/KuTuW.png)


InputAliases and SelectionPlaceholder issue in V10

Let's create an example and do the test:               CreateDocument[{},  InputAliases -> {"[" ->      RowBox[{"\[LeftDoubleBracket]", "\[SelectionPlaceholder]", "\[RightDoubleBracket]"}]}]      ![enter image description here](http://i.stack.imgur.com/WOSBg.png) As you can see this is not what I expected. `SelectionPlacholder` has changed to `Placeholder`. OS: Win7 Can you reproduce the problem? It is not only the case of custom aliases but each built-in behaves the same...


How to count the number of n-gons and line intersections in an image of a complete graph?

I would like to count the number of line intersections and number of n-gons in a complete graph (which forms a regular polygon). The only way I've come up with that would allow me to do both in _Mathematica_ would be to:   1. Produce an image of the graph;    2. Apply some image processing tricks. I'm completely new to the world of image processing though. Here is an example of a 10-graph:               n = 10;     firstCorners = Table[{Cos[2 Pi i], Sin[2 Pi i]}, {i, 0, 1, 1/n}];     lines = Subsets[firstCorners, {2}];     img = Image[Graphics[{Thick, Line[lines]}, ImageSize -> 350]]      ![Mathematica graphics](http://i.stack.imgur.com/6ZPD8.png) I've got no idea how to proceed from here, everything I've tried has failed.


DSolve bvfail "For some branches of the general solution, unable to solve the conditions"

I have a problem with the `DSolve` function and its usage:               solOC1 = DSolve[{y'[t] == (r - (1 - x[t]/X0)) y[t], x'[t] == -C*y[t], y[0] == Y0,                      x[0] == X0} /. {Y0 -> 1, r -> 1, X0 -> 1, C -> 1}, {y, x}, t]      The Professor of our Institute coded it some months ago and this was the result:               {{x -> Function[{t}, Sqrt[3] Sqrt[Tanh[1/2 (-Sqrt[3] t - 2 ArcTanh[1/Sqrt[3]])]^2]],        y -> Function[{t}, -(3/2) (-1 + Tanh[1/2 (-Sqrt[3] t - 2 ArcTanh[1/Sqrt[3]])]^2)]},       {x -> Function[{t}, Sqrt[3] Sqrt[Tanh[1/2 (-Sqrt[3] t + 2 ArcTanh[1/Sqrt[3]])]^2]],        y -> Function[{t}, -(3/2) (-1 + Tanh[1/2 (-Sqrt[3] t + 2 ArcTanh[1/Sqrt[3]])]^2)]}}      But when we run the script now we get a bvfail:               DSolve::bvfail: For some branches of the general solution, unable to solve the conditions.>>      I have no idea what is causing this. Any suggestions how to handle the problem ? Sebastian


How can you give a Module a context and have its local variables and Modules belong to that context?

What would be the best way to give a module its own context and have its local variables and Modules belong to that context?


Grouping units more sanely

Would it be possible to get Mathematica to group units more sanely. For example the calculation:               m = Quantity["Meters"];     D[       D[        Sin[p] (m),        Quantity[p, "Seconds"]] ,       Quantity[p, "Seconds"]] // Expand      This gives an visual output:               (-1 m/s^2) Sin[p]      however it would be more natural to show:                -Sin[p](m/s^2)      I there a way to make this happen. Notes:   * Expand is strictly not necessary in this case but can nice be in more complex cases.


Notation, Format and Interpretation

I am unclear on the exact relationship between `Notation`, `Format` and `Interpretation`. `Format[X] := Y` seems similar to `Notation[Y <= X]` for formating and `Interpretation[X, Y]` seems related to `Notation[X => Y]` for parsing but I am not sure how they fit together and when to use which.


Distributing PlusMinus consistently

I would like to give the built-in function `PlusMinus`, which is undefined by default, the intuitive meaning: considering all possible combinations of $+$ and $-$. For simple expressions, this can be implemented as follows:               PlusMinus[a_,b_] := Flatten[{a+b,a-b}]     a \[PlusMinus] b \[PlusMinus] c      > >     {a+b+c, a-b+c, a+b-c, a-b-c} >   However, there are of course more complicated examples, such as when $\pm$ appears in a function's argument, for example I would like to do the same thing for arbitrary (non-`listable`) functions $f(a\pm b\pm\cdots)$, which should by the same principle yield > >     {f[a+b+...], f[a-b+...], ...} >   To complicate things even further, consider   * $f(a\pm b, c)$   * $a+f(b+c\pm d,e)$   * $\frac{-b\pm\sqrt{b^2-4ac}}{2a}$   * ... Can this be implemented purely by giving `PlusMinus` the appropriate definitions?


Calculating electrostatic potential from arbitrary charge density

In electrostatics, one often desires to know the electrostatic potential generated from the outside of a charge distribution; however, I am interested in finding the electrostatic potential _inside_ of a charge distribution. For example, let's consider a parabolic charge distribution: $\rho(x) = x(L-x)$ Where L is the length of the distribution. Now if we wish to calculate the electrostatic potential, we would need to calculate: $\Phi(z) = \int_0^L \frac{\rho(x)}{|z-x|} dx = \int_0^L \frac{x(L-x)}{|z-x|} dx$ In turn one could take the derivative of $\Phi(z)$ to obtain the electric field inside the distribution. My attempt to do this in mathematica:               L = 1;     s[z_] := z (L-z)     fen[x_] := Integrate[s[z]/Abs[z - x], {z, 0, L}, PrincipalValue -> True, Assumptions :> {L > x > 0}]     V = fen[x]     El = fen'[x]     Plot[{V, El}, {x, 0, 1}]      Any ideas? Thanks!


Numerical Methods - minimum of a function

## Problem: The length of the longest ladder that can negotiate the corner depicted in Figure 2 can be determined by computing the value of theta that minimizes the following function: > $L(theta)=w1/sin(theta)+w2/sin(pi-alpha-theta)$ For the case where w1 = w2 = 2 m, use a numerical method to develop a plot of L versus a range of alpha's from 45 to 135 degrees. ![Figure2](http://i.stack.imgur.com/l1x0P.jpg) ## Solution so far: Until now, I could think of 2 methods for solving this problem: The first method was to compute the derivative and solve the equation `L'(theta)=0` and from here find theta for which the function has a minimum value. Here is the code:               L[th_] := 2/Sin[th] + 2/Sin[135 Degree - th]     NSolve[D[2/Sin[th] + 2/Sin[135 - th], th] == 0, th]     N[Minimize[D[L[th], th], {th > 0}, th]]      The output of NSolve gives me the following error `NSolve::ifun: Inverse functions are being used by NSolve, so some solutions may not be found; use Reduce for complete solution` information and this results               {{th -> -1.61504}, {th -> -0.0442421 - 0.0442132 I},      {th -> -0.0442421 + 0.0442132 I}, {th -> 1.52655},      {th -> 3.09735 - 0.0442132 I}, {th -> 3.09735 + 0.0442132 I}}       which are a lot of values and I don't know which one is the right one. For the Minimize function I get this error and nothing gets computed `NMinimize::nnum: The function value (L^\\[Prime])[0.0914636] is not a number at {th} = {0.0914636}. >>` The second approach was to use a root-location technique. I chose the Newton- Raphson, but the results obtained were in a strange form. This is the code:               th1 = 1          thl = 10          thu = 100          thr = thu - (L (thu)*(thl - thu))/(L (thl) - L (thu))          NewRa = {1}          h = D[L[th], th]          For[i = 2, i <= 4, i++, a = NewRa[[i - 1]]; b = h /. x -> a;      AppendTo[NewRa, a - L[a]/b]]          NewRa          {1, 1 - (2 Csc[1] + 2 Csc[1 + 45 \[Degree]])/(-2 Cot[th] Csc[th] -      2 Cot[45 \[Degree] + th] Csc[45 \[Degree] + th]),      1 - (2 Csc[1] + 2 Csc[1 + 45 \[Degree]])/(-2 Cot[th] Csc[th] -      2 Cot[45 \[Degree] + th] Csc[45 \[Degree] + th])       Am I approaching the problem in the right way? If yes, how can I solve the error from Mathematica?


Is it possible to create a styled cell with pre-defined content?

When you create a new styled notebook from the Stylesheets chooser dialag, you get a new notebook using the chosen style with some sample content provided. ![enter image description here](http://i.stack.imgur.com/F5Ycu.png) ![enter image description here](http://i.stack.imgur.com/h4qZw.png) * * * But if you apply styles from the same stylesheet to an open blank notebook, there will be no sample content such as `Enter title here` * * * My question is how can I create one new cells with a given style and some sample content already present? For example: I would like to be able to press `Alt+1` to create a Title-style cell with words `Enter title here`.


Function that caches when it returns unevaluated

How would you go about implementing a function that caches not the result but the fact that it didn't match a pattern? So that it doesn't waste time recomputing a complex time-consuming pattern condition every time it needs to evaluate the expression.               f[i_] := Module[{res},         res /; (           res = i^2(* some time consuming calculation *);            Print[i];            res < 8)]      I'd like that if I run the following example I don't get two Print statements but only one.               f[20];f[20];      An ideal solution would provide a way to make the pattern matcher skip a particular definition if it previously found it didn't fit. However, I'm happy enough with a nice way to make MMA just "let the unevaluated expression be" without wasting time every time it reevaluates it only to find it returns unevaluated. So far I'm thinking of               Module[{fMatch},      fMatch[_] := True;      f[i_] := Module[{res},         res /; fMatch[i] && (           res = i^2           (* some time consuming calculation *);           Print[i];           fMatch[i] = res < 8)]      ]      which seems to work I guess. You have better ideas, or think that needing this kind of construction is a sign of bad programming?


LinePlot in For loop

I have the following Mathematica code to approximate Pi as inspired by the Matlab code in George Zhao Ideas                   n = 100000;     count = 0;     For[i = 0, i <= n, i++;       roll = RandomVariate[UniformDistribution[{0, 1}]];       count = count + 4 Sqrt[1 - roll^2];]     {count, n, count/n}      I tried to insert ListPlot in the For loop but failed. My intention is to show how the {count/n} move per iteration. So, the ListPlot will get longer (approaching the Pi value) as the interation moves on. Appreciate any help. thanks.


Plot the boundaries of each piece of a piecewise function

I'm wondering how to **plot the boundaries of each piece** of a bivariate piecewise function. Lets take for instance the following piecewise linear function $B_{111}(x,y)$:               B11[x_, y_] = Piecewise[{{1, 0 <= x <= 1 && 0 <= y <= 1}}]     B111[x_, y_] = Integrate[B11[x - t, y - t], {t, 0, 1}]      At the moment, I use the following Plot3D command to visualize the function:               Plot3D[B111[x, y], {x, -0.2, 2.2}, {y, -0.2, 2.2},             PlotRange -> Full, PlotPoints -> 25, Axes -> False,             Boxed -> False, Mesh -> None]      ![enter image description here](http://i.stack.imgur.com/UCOHS.png) Although in this particular case the **boundaries of the individual pieces** are already visible due to low quality plot settings, how can I actively plot these boundaries (i.e. as mesh or wireframe) in the same visualization? **Edit:** In this case, it should result in a wireframe consisting of **six triangles** (and **one hexagon** ): ![enter image description here](http://i.stack.imgur.com/H75IO.png) Additionally, is it possible to add some kind of constraint to the `Plot3D` function, such that it only visualizes the actual function? In other words, it should exclude the parts where the function is not defined (i.e. outside the support assigned a grey color in the image below).


Replace all instances of Integrate by NIntegrate and add a Method option

I have an analytic expression which involves several integrals               Integrate[f[x], {x, lb, ub}]      where the functions `f` and bounds `lb`, `ub` differ. I now would like to   1. replace `Integrate` by `NIntegrate`, while leaving the arguments of `Integrate` unchanged   2. specify a specific method for numerical integration, such as `Method -> "GaussKronrodRule"` I manage to accomplish (1) by               Integrate[f[x], {x, lb, ub}] /. Integrate -> NIntegrate      but I have no clue how to do (2).


Composition of functions

I have a number of rotations computed by `rot = RotationTransform[theta, point]`, and I would like to compose them to produce one function that is the composition of all the rotations. I need this function in a form that I can then use in, say, `FindMinimum[]`. I solved my problem by using `TransformationMatrix[rot]`, multiplying all the matrices, and defining a function based on that. But it would be cleaner to create one function that is the composition of the others, rather than take the detour through matrices. Ideally I would input a list of `theta, point' values, and get back a function that is the composition of all those rotations. I'd appreciate learning how to do this. Thanks!


Defining a string based sort function

I'm having a bit of trouble figuring out the right `Sort` syntax to use on a list of lists. Consider the following list:               list=     {      {"B0T", "Ch72", "T0p36K", "Vdiv2047p92", "Vg75V"},      {"B0T", "Ch70", "T0p28K", "Vdiv2047p92", "Vg65V"},      {"B0T", "Ch70", "T0p28K", "Vdiv2047p92", "Vg60V"},       {"B0T", "Ch72", "T0p36K", "Vdiv2047p92", "Vg70V"}      }      I would like the resulting list to have the following:   * Order first by anything looking like "T[0-9p]+K" (regex), and rearrange to have this value be first   * Then order by "Vg[0-9p]+V", and rearrange to have it be 2nd.   * Then order by "Ch[0-9]+", and rearrange to 3rd,   * Then order the rest in alphabetical order, and rearrange So, the final outcome would be:               {      {"T0p28K", "Vg60V", "Ch70", "B0T", "Vdiv2047p92"},       {"T0p28K", "Vg65V", "Ch70", "B0T", "Vdiv2047p92"},      {"T0p36K", "Vg70V", "Ch72", "B0T", "Vdiv2047p92"},       {"T0p36K", "Vg75V", "Ch72", "B0T", "Vdiv2047p92"}     }      Note: while it looks like all of the columns would be the same at the beginning, they might not always have the same position, and the number of columns themselves might change. FWIW, eventually I will be separating the strings above with:               valRegExp =       RegularExpression[       "(Vdiv|T|Vbias|Vg|B|Ch)([Ss][Ww]|[\-0-9p]+)(K|V|T)?"];     Map[Flatten[StringCases[#,       valRegExp :> {"$1", StringReplace["$2", "p" -> "."],         "($3)"}], {2}][[1]] &, list]      Is there a way to sort them "in place"? Is this better approached as a two step function: first sort, then rearrange? **EDIT** Heike's answer along with a call to               Clear[SortByColumn]          SortByColumn::usage =      "SortByColumn[List,Column,Direction]: Returns the list sorted by \     'Column' in either ascending (Direction= \"asc\") or descending \     (Direction = \"desc\") order. Default is in ascending order. For \     sorting more than one column, input Column as a list. For example, \     Column={1,2} will sort first on Column 1, then on Column 2.";          SortByColumn[list_List, col_, dir_String: "asc"] :=       Which[dir == "desc",        Sort[list, ! OrderedQ[{#1[[col]], #2[[col]]}] &], dir == "asc",        Sort[list, OrderedQ[{#1[[col]], #2[[col]]}] &]]      Actually solves my problem, I think.


NIntegrating within an Ellipsoid

I need to numerically integrate an expensive positive-definite function over a 2D domain. I know by other ways that the function is basically zero for values outside the following ellipse: `Ellipsoid[center,Sqrt[Eigenvalues[matrix]], Eigenvectors[matrix]]` How do I tell Mathematica to integrate only within the ellipsoid? * * * Here is what I got using your nice suggestions (timings are normalized to the slowest): 100 sec - integration over the rectangle circumscribing the ellipse 55 sec - using Boole to integrate only over ellipse (@b.gatessucks) 47 sec - directly limiting the domain to the ellipse (@whuber) 41 sec - mapping the ellipse to a unit circle (@Jens)


How do I hide some of Input

I have a project with a friend, and we make some work in Mathematica. He is not very good at Mathematica, and I have made some long necessary formulas we need. I would like to show what I've made but only show what's important. Therefore I need to hide some of the input but not all of it. I have made some research and found this:               AutoCollapse[] := (If[$FrontEnd =!= $Failed,SelectionMove[EvaluationNotebook[], All, GeneratedCell];      FrontEndTokenExecute["SelectionCloseUnselectedCells"]])      The problem with this is it hides all input when used. The example i made below, is it possible in some way, or do I have to break it up into two different inputs?               "In(1):      1+1     3+3     Out(2):     1+1     2+2     3+3"


Can SetDelayed (:=) be compiled?

Is it possible to put an `If` statement as below within a compile (see below)? I received a warning about `SetDelayed`.                 eef = Compile[{{μ, _Real}, {NNN, _Integer}},         Module[{NN = NNN},           kd[m_, n_] := If[m == n, 1, 0];          cosfun[m_, n_] :=             If[m == n,                0,                (1 - Cos[(m + n) π])/( (m + n) π)                + ((Cos[(m - n) π] - 1)/( (m - n) π))            ];                mm = Table[kd[m, n] (MM - B2 k k - B1 (m Pi/L)^2),                     {m, 1, NN}, {n, 1, NN}];           kz = Table[cosfun[m, n] (-I A2 m Pi/L), {m, 1, NN}, {n, 1, NN}];           kxM = Table[kd[m, n] A1 k, {m, 1, NN}, {n, 1, NN}];           μM = Table[kd[m, n] μ, {m, 1, NN}, {n, 1, NN}];                HH = ArrayFlatten[{                  {μM + mm, 0 mm, kz, kxM},                   {0 mm, μM + mm, kxM, -kz},                   {kz, kxM, μM - mm, 0 mm},                   {kxM, -kz, 0 mm, μM - mm}                }];                ees = Table[Eigenvalues[HH], {k, -.1, .1, .01}]               ] (* End Module  *)         ]  (* End Compile *)      where `A1`, `A2`, `B1`, `B2`, and `MM` are global variables.


Probability problem -- Rube Goldberg solution?

A user posted this question on StackOverflow which was closed as off topic: > 3 people are playing a game with a standard 52 card deck. Each player is > given 2 cards each, possible cards and their values being $\mathrm A = 1$, > $2=2$, $\ldots$, $\mathrm J=11$, $\mathrm Q=12$, $\mathrm K=13$. A player > wins if the sum of his cards is greater than both of the sums of the other > player's cards. What is the winning probability for each player? I am curious to see this problem receive the kind of solution that David gave here. Allowing _Mathematica_ to do as much of the thinking for you as possible, how can this be solved?


How to parallelize a the calculation of a vector function which is inside a recursive formula

I need some help with parallelizing the calculation of a vector function `F` which is inside a recursive formula. An example of the code is below for few iterations. The function `F` is calculated using all the values for `r` in the last iteration. The time consuming part of the code is the calculation of `F` and increase rapidly when the iterator `p` is large (For example 100).               r[1, 1] = {1, 0, 0};     r[2, 1] = {0, 1, 0};     r[3, 1] = {0, 0, 1};     F[1, 1] = {1, 0, 1};     F[2, 1] = {1, 0, 1};     F[3, 1] = {1, 0, 1};               F[i_, n_] := -(Sum[1/Norm[r[i, n] - r[j, n]], {j, 1, i - 1}] +                Sum[1/Norm[r[i, n] - r[j, n]], {j, i + 1, p}]);                p = 3;     nsteps = 50;     Do[Do[{r[i, n] = r[i, n - 1] + F[i, n - 1]}, {i, 1, p}], {n, 2,         nsteps}];     Table[r[1, n], {n, 1, nsteps}] // TableForm


Plotting adiabatics

I have the following code for drawing two isotherms for a Carnot engine:               R = 8.3*(10^3); n = 1;      P[V_, T_] := n*R*T/V      Plot[{P[V, T = 355], P[V, T = 295], P[V = 0.0006, T = 295]}, {V, 0.0008, 0.0036},        AxesOrigin -> {0, 0},        AxesLabel -> {"Volume (cubic meters)", "Pressure (N/m^2)"}]      It's fine (though a word on how to exaggerate the vertical proportions _without_ the aspect ratio command would be great). But, what I want to do is plot the sides of this Carnot cycle problem -- I can get the isotherms, but when I add a third expression (like one where a different variable is held constant, i.e. volume) it seems to choke on it. Anyhow, any help for someone who knows almost nothing about _Mathematica_ :-) `Overlay` didn't seem to do it.


How to get FullSimplify to fully simplify my expression with custom complexity function?

To simplify based on the visual complexity of an expression (i.e. the complexity of the function as displayed in the notebook instead of the internal form, which in some cases may be substantially different), I've defined the following complexity function:               VisualComplexity:=(Count[ToBoxes[#], Except[" "|"("|")", _String], Infinity]&)      This works well on some simple examples, however not on the following:               FullSimplify[(-1+a)(-1+b) + Abs[c]^2 - Abs[d]^2,                  ComplexityFunction->VisualComplexity]     (*     ==> 1 - a - b + a*b + Abs[c]^2 - Abs[d]^2     *)      What I had expected (and desired) would have been `(1-a)(1-b) + Abs[c]^2 - Abs[d]^2`. Note that with the built-in complexity function, it converts `(1-a)(1-b)` to `(-1+a)(-1+b)` in that context, so transforming between those two forms is definitely in the capabilities of `FullSimplify`. Now my first thought was that maybe that's really less complex according to my complexity function (which would have meant tweaking that function). However, it turned out that the desired form indeed _is_ computed to be less complex:               VisualComplexity /@ {1 - a - b + a*b + Abs[c]^2 - Abs[d]^2,                          (1-a)(1-b) + Abs[c]^2 - Abs[d]^2}     (*     ==> {20, 18}     *)      Therefore my question is: How do I get FullSimplify to generate the simpler form?


Table doesn't replace inside conditionals (If, Which)

This:               Table[If[cond, y], {y, 1, 3}]      outputs this:               {If[cond, y], If[cond, y], If[cond, y]}      The `y` is not replaced by its value, as is normally the case with `Table[]`. This also happens with `Which[]`. How do I get Table to actually replace the values for y? Why does this happen?


How to calculate the whole run time in a specific notebook?

I have found a way to show the run time in a specific cell in a notebook (.nb). Now, I want to have the whole run time including all cells in a specific notebook. How is it possible to calculate it ? Is there any special functions or commands or options ?


Why doesn't PlotMarker option None return no PlotMarkers?

After reading the `PlotMarkers` documentation it seems to be all or nothing. For example if you wanted markers on some of you lines the code below seems possible/probable given the documentation:               ListPlot[Table[n^(1/p), {p, 4}, {n, 10}],      Joined -> True,      PlotMarkers -> {{"\[FilledSquare]", 10.9`}, None,         None, {"\[EmptyCircle]", 9}}]      But this doesn't work. ![enter image description here](http://i.stack.imgur.com/dmpwp.png) It seems that an empty string is the only way to get no markers for some of the lines if you choose markers on others. Is this correct or am I misusing `PlotMarkers`? When using an empty circle marker the background is transparent so the line can be seen underneath. If I want filled white circle with an `EdgeForm` colour that obscures the plot line I can make one and use it as a marker as per instructions in the documentation but then I run into the headache of wanting to parse the default (or other) colours to the `EdgeForm` directive. This can be developed but what a headache. Has anyone got any easy work arounds?               ListPlot[Table[n^(1/p), {p, 4}, {n, 10}],      Joined -> True,      PlotMarkers -> {{Graphics[{EdgeForm[Directive[ColoursGoHere,Thick, Thick]], White,            Disk[{0, 0}, 1]}], 0.05}}]      ![enter image description here](http://i.stack.imgur.com/6oia4.png)


ColorFunction and/or ColorScaling issue with ParametricPlot3D

My goal is to use `ColorFunction` to color a cylinder based on the $z$ value of a separate `Plot3D`. I'm not sure if I am making a mathematical error somewhere or if I am just messing up some snippet of the following code.               a = Pi;     b = 2;     f[x_, y_] = y;     u[x_, y_, t_] = -((8 E^(-((\[Pi]^2 t)/20)) (2 - \[Pi]) Cos[(\[Pi] y)/4])/\[Pi]^2) -         (8 E^(-((\[Pi]^2 t)/5)) (2 + 3 \[Pi]) Cos[(3 \[Pi] y)/4])/(9 \[Pi]^2) -         (8 E^(-((9 \[Pi]^2 t)/20)) (2 - 5 \[Pi]) Cos[(5 \[Pi] y)/4])/(25 \[Pi]^2);          Table[ContourPlot[u[x, y, t], {x, -a, a}, {y, 0, b},         ColorFunction -> ColorData["TemperatureMap"],         Contours -> 8], {t, {0, .1, .3, .5, 1, 2, 3, 4}}]      ![enter image description here](http://i.stack.imgur.com/rNWy9.png) Now, I want to wrap each contour plot onto a cylinder by gluing the $x=-a$ edge to the $x=a$ edge; the bottom of the cylinder is then at $y=0$ and the top at $y=b$.                Table[ParametricPlot3D[{Cos[theta], Sin[theta], rho}, {theta, -Pi, Pi}, {rho, 0, 2},           AxesLabel -> {x, y, z}, ColorFunctionScaling -> False,          ColorFunction -> Function[{x, y, z, theta, rho},          ColorData["TemperatureMap"][u[x, rho, t]]],         Mesh -> 8, MeshFunctions -> {Function[{x, y, z, theta, rho},          f[Cos[theta], rho]]}, ViewPoint -> {-2.3, 0.77, -2},          ViewVertical -> {-0.08, 1, -0.06}],          {t, {0, .1, .3, .5, 1, 2, 3, 4}}]      ![enter image description here](http://i.stack.imgur.com/s5TMW.png) This is clearly not correct based on what I am after. Where am I going wrong? I tried turning `ColorFunctionScaling` off and on with no luck. I also tried replacing that middle snippet dealing with the coloring with               ColorFunctionScaling -> False,      ColorFunction -> Function[{x, y, z, theta, rho},      ColorData["TemperatureMap"][Rescale[u[Cos[theta], rho, t], {0,2}]]]      where a `Plot3D` shows $u(x,y,t)$ ranges over (about) $[0,2]$. I suspect the solution lies in some tweaking of this part.


How can I add shortcut to StyleBox

### How can I add shortcut to StyleBox * * * we can `Ctrl+B` to overstrike **font.** **i.e. **strong** or `**strike**`.** Can I add one new shortcut `Ctrl+R` to make the font become $\color{red}{Red}$? Because they both are Style/StyleBox `StyleBox["Bold", FontWeight->"Bold"]` `StyleBox["Red", FontColor->RGBColor[0, 0, 1]]`


Why can't Mathematica parallelize this?

The following code makes mathematica print "ParallelTable::nopar1: [...] cannot be parallelized; proceeding with sequential evaluation."               (*Exit[]*)     Subscript[r, 1] = Abs[x + y I];     Subscript[r, 2] = Abs[x + y I - a];     plots = ParallelTable[        ContourPlot[{Abs[Subscript[r, 1]]/Abs[Subscript[r, 2]] ==              Subscript[c, 1],             Subscript[c, 2] ==              Abs[Subscript[r, 2]] - Abs[Subscript[r, 1]]} /. a -> 5 //           Evaluate, {x, -6, 6}, {y, -6, 6},          FrameTicks -> {Range[-6, 6, 1], Range[-6, 6, 1], None,            None}], {Subscript[c, 1], 0, 2, 0.1}, {Subscript[c, 2], -2, 2,          0.2}];     Animate[plots[[i]][[j]], {i, 1, Length[plots], 1}, {j, 1,        Length[plots[[1]]], 1}]      Why does this happen even when the expression in ParallelTable can be easily evaluated for any values of $c_1$ and $c_2$ ? Note: "Right Click> convert to StandardForm" will make the subscripts readable.


Inserting a closed section

Is there a way to insert a closed section? I know in .m files if you do `(* ::Section::Closed:: *)` and open the .m file using system editor, a closed section will be displayed. Is there a way to create a closed section in the notebook while using `CreateDocument[]`?


Anyone recognize this heatmap?

Anyone know the origins of the attached heatmap/daylight overlay? I see it on the Mathematica homepage all the time and I even saw it once on Wolfram|Alpha launch video. I know there are ways to generate both heatmaps and daylight overlays, but does Mathematica have built in functionality that does something like this? ![Heatmap](http://i.stack.imgur.com/T3RFs.png) Yes, I realize this might be an odd question, but it's been bugging me for a while...


How to create interrelated sliders?

Say I want a slider that controls the value of $x$ and another slider that controls the value of $2x$, how would I go about it?


Eigensystem, Eigenvalue doesn't output nonreal eigenvalues

Basically I have a matrix and when I used either `Eigenvalue` or `Eigensystem`, it doesn't output nonreal eigenvalues, instead it leaves it in the form of $$\sqrt{-1}^{1/3}$$ or something in terms of $\sqrt{-1}$ The matrix I have is > >     F = {{-1/4, 1/4 + 1/Sqrt[2], -1/2 + 1/(2  Sqrt[2])}, >          {1/4 - 1/Sqrt[2], -1/4, -1/2 - 1/(2 Sqrt[2])}, >          {-1/2 - 1/(2 Sqrt[2]), -1/2 + 1/(2 Sqrt[2]), 1/2}} >   I am trying to diagonalize this. **EDIT** Adding `Simplify` seems to have solved half of the problem, it displays the eigenvectors in complex numbers, but the eigenvalues still in unsimplified form.


Replace function call with expression resulting from the symbolic evaluation of the function when defining a second function?

Suppose the evaluation of a function `f[x_, y_] := ...` takes a very long time, but the output is a not-so-complicated polynomial in `x` and `y`, say `x+y`. The evaluation is long for many reason, but one of these is that a lot previous defined functions are called. Now I continue and define a function               g[x_, y_] := Some Easy Operations on f[x,y]      Of course, when I evaluate `g[x, y]` symbolically or with numerical values, it calls `f[x ,y]`, right? Hence the evaluation of `g` is long also. But if I define               g[x_, y_] := Some Easy Operations on x+y      then the evaluation is fast. However, the relation between `f` and `g` is less obvious in the definition of `g`. ### My questions   * Is what I mentioned above correct?    * Where I can find a reference to get a basic idea/some principles about how to optimize code like this?


How could I change the apperance of a button when some hard computation is finished?

I want to have some bottons inside manipulate to calculate some time consuming functions. For example the following code changes its color after the calculation of Total[Range[123456000]] is finished. I tried               Dynamic@Button["xxx", Clear[x1]; x1 = 0; FinishDynamic[];        Total[Range[123456000]];        x1 = 1/2, Background -> Dynamic[Hue[x1]]]      with success but when I want to localize the Dynamic variable x1 inside Manipulate(or DynamicModule) there is no result! For example, the following code does not work for me!               DynamicModule[{x1},       Button["xxx", Clear[x1]; x1 = 0; FinishDynamic[];       Total[Range[12345600]]; x1 = 1/2,        Background -> Dynamic[Hue[x1]]]]      Any ideas please?


Connecting to remote kernel on iMac from a MacBook Pro client

I am having trouble setting up a remote kernel connection between my two Mac computers. The kernel on my iMac runs much faster than on my MacBook Pro, so I would like to run computations through my iMac when I am out of town. I have set up ssh on my iMac and have no problem connecting to it via ssh in a Terminal window from my MacBook. I can even run the remote kernel from the command line by entering "/Applications/Mathematica.app/Contents/MacOS/MathKernel" without any problems. However I cannot set up a remote kernel from my front end despite putting this exact same command for "Kernel Program." Mathematica displays the "cannot connect to remote kernel" error before even asking me for a password to log into my remote machine. I am really at a loss as to what is wrong (I am not very familiar with computers at all) and any help would be appreciated.


Is the formula $\sum _{m=1}^{n-1} \prod _{k=m+1}^n x_k x_m$ wrong in the wiki's page

SymmetricPolynomial[2, {Subscript[x, 1], Subscript[x, 2], Subscript[x,   3], Subscript[x, 4]}]      $$\begin{align*}x_1 x_2+x_3 x_2+x_4 x_2+x_1 x_3+x_1 x_4+x_3 x_4\tag{1}\end{align*}$$               Plus @@ Subsets[  Times[Subscript[x, 1], Subscript[x, 2], Subscript[x, 3], Subscript[   x, 4]], {2}]      $$\begin{align*}x_1 x_2+x_3 x_2+x_4 x_2+x_1 x_3+x_1 x_4+x_3 x_4\tag{2}\end{align*}$$ However if I follow the formula (3) from this page. Then, I'll not get (1), but get (4) $$\begin{align*}\sum _{m=1}^{n-1} \prod _{k=m+1}^n x_k x_m\tag{3}\end{align*}$$               \!\(\*UnderoverscriptBox[\(\[Sum]\), \(m = 1\), \(n - 1\)]\(\*UnderoverscriptBox[\(\[Product]\), \(k = m + 1\), \(n\)]\*SubscriptBox[\(x\), \(k\)]\ \*SubscriptBox[\(x\), \(m\)]\)\) /. n -> 4      $$\begin{align*}x_2 x_3 x_4 x_1^3+x_2^2 x_3 x_4+x_3 x_4\tag{4}\end{align*}$$ Since $\prod _{k=m+1}^n x_kx_m$ may be some notations that I'm not familiar with, I'm not sure whether the formulas in the wiki's page is wrong. * * * Replace product in (3) with summation, then we will get the right/expected result.               \!\(\*UnderoverscriptBox[\(\[Sum]\), \(m = 1\), \(n - 1\)]\(\*UnderoverscriptBox[\(\[Sum]\), \(k = m + 1\), \(n\)]\*SubscriptBox[\(x\), \(k\)]\ \*SubscriptBox[\(x\), \(m\)]\)\) /. n -> 4      $$\begin{align*}x_1 x_2+x_3 x_2+x_4 x_2+x_1 x_3+x_1 x_4+x_3 x_4\tag{5}\end{align*}$$ ![Mathematica graphics](http://i.stack.imgur.com/jHdgE.png) ![Mathematica graphics](http://i.stack.imgur.com/Cuz97.png) ### Are the formulas wrong? or Is my calculating method in _Mathematica_ wrong? Note that some notations with the complex use of $\Pi$ and $\sum$ in symmetric polynomials


Tooltips with Popupmenus, can't supress the popups prior to clicking

I'm trying to add popupwindows to tooltips for points on an ErrorListPLot but all the popupwindows appear on screen immediately when I run the command below that plots the graph. After closing all the popupwindows the tooltips and popupwindows work as intended, so when I hover over the points in the plot I get the right tooltip, and when I click on the points I get the popupwindow. I thought I was missing a semicolon somewhere but I think it is more basic then that. The tooltips are unique for each point so they are indexed in a loop, but this simplified example illustrates the problem with the popupwindows appearing prior to clicking on the points. I'm sure there must be an amazingly concise and elegant fix using # & and @ characters amongst others but I am a complete novice in need of enlightenment! Thanks for taking the time to read this.               xyPoints= {{{-152., 1.428}, {-83.9858, 1.88051}, {-84.,         2.066}, {-133.466, 1.76653}}, {{-152., 1.428}, {-83.9858,         1.88051}}, {}, {}, {}, {}, {}, {}, {}, {}}          errorBars= {{ErrorBar[{-86.0233, 86.0233}, {-0.07, 0.07}],        ErrorBar[{-70.3562, 70.3562}, {-0.0494975, 0.0494975}],        ErrorBar[{-111.803, 111.803}, {-0.1, 0.1}],        ErrorBar[{-81.7902, 81.7902}, {-0.0647275,          0.0647275}]}, {ErrorBar[{-86.0233, 86.0233}, {-0.07, 0.07}],        ErrorBar[{-70.3562, 70.3562}, {-0.0494975,          0.0494975}]}, {}, {}, {}, {}, {}, {}, {}, {}}          test = Table[        Table[{PopupWindow[           Tooltip[Transpose[{xyPoints[[i]], errorBars[[i]]}][[j]],            Grid[{{"Tooltip hello"}}, Alignment -> Left, Frame -> All],            TooltipStyle -> Medium],           Pane[Grid["Popup hello"], Scrollbars -> True,             ImageSize -> {650, 400}], WindowSize -> {700, 450}]          }, {j, Range[Length[errorBars[[i]]]]}],        {i, Range[maxSeries]}];          ErrorListPlot[test[[1]]]


What's wrong with my implementation of SquareFreeQ?

This was a question I had last month: > **Part A:** Looking at the exponent of each of the elements in the list, > `FactorInteger` and using `Select` construct your own variant of > `SquareFreeQ`. Call it `squareFreeQ`. (You want the list of powers in > `FactorInteger` to be all be 1, equivalently no power should be greater than > 1 . The right `Select` evaluated on `FactorInteger` should give `{}`. Notice > we only have to find one power > 1 so you will speed things up by using > `Select` with an option. > > **Part B:** Test that your construction `squareFreeQ` and _Mathematica's_ > `SquareFreeQ` are identical. You can do this by selecting the integer for > which `SquareFreeQ[n] != squarefreeQ[n]`. Do this on a list of $10^5$ random > integers between $10^{13}$ and $10^{14}$. Tell me how long it takes to > perform this test. Be prepared to wait a little while. This is what I had for part A:               squareFreeQ := Select[Last /@ FactorInteger[#], # > 1 &] &      and for part B:               Timing[SquareFreeQ[#] & /@ RandomInteger[{10^13, 10^14}, 10^15]]     squareFreeQ := Select[Last /@ FactorInteger[#], # > 1 &] &      When I got my assignment back, it says incorrect with no explanation. What would be the correct answer? Please explain.


Taking the LCM of algebraic expressions

Is it possible in _Mathematica_ to take the `LCM` of an algebraic expression? For example, I want to take the `LCM` of $9$, $9y$, $12y^2$ and $27y^4$. If I type in               LCM [9, 9y, 12y^2, 27^4]       it returns the same value. I'm running _Mathematica_ version 9. Could you help me out?


Using Position (which requires a pattern) in the same manner as Select (which requires a criterion)

I am using Mathematica7. I have a list of lists (creatively named `list` in the following sample code) containing data. I would like to find the positions of the elements that satisfy a particular criterion. However, `Position` takes a pattern as input, whereas `Select` takes a criterion as input. Suppose I want to find the positions of all lists (i.e., sublists) whose first element is `1`. The following code works (or so it seems), but it generates error messages as well:               list = {{1, "A"}, {1, "B"}, {2, "C"}};     Position[list, _?(#[[1]] == 1 &)]      The output looks correct: `{{1},{2}}` But I also get the following error messages, which in a long computation seem to slow down `Position`: > >     Part::partd : Part specification List[[1]] is longer than depth of > object. >     Part::partd : Part specification List[[1]] is longer than depth of > object. >     Part::partd : Part specification [[1]][[1]] is longer than depth of > object. >     General::stop : Further output of Part::partd will be suppressed during > this calculation. >   Does my code indeed work properly? If so, why do I get the error messages? If not, how can I improve my code?


Bad function evaluation

I am having some trouble with this function               Subscript[f, \[Pi]] = {0.0924, 0.00025};     Pade[x_, n_, m_] :=Sum[Subscript[a, i]*(x)^i, {i, 0, n}]/(     1 + Sum[Subscript[a, i]*(x)^(i - n), {i, n + 1, n + m}]) /.      Subscript[a, n + m] -> Subscript[a, n]/(2 Subscript[f, \[Pi]][[1]])      Then, this function works ok but all x values but 0, which gives back               In[226]:= Pade[0, 0, 1]     During evaluation of In[226]:= Power::indet: Indeterminate expression 0^0  encountered. >>     Out[226]= Indeterminate      However it works ok if I do               In[228]:= Pade[x, 0, 1] /. x -> 0     Out[228]= Subscript[a, 0]      Any idea why is this? Indeed the kind of indetermination, 0^0 it's freaking me out, theres no such a power law in my function definition, so I don't have a clue of why is this happening ...


What's the difference between EdgeDetect and MorphologicalPerimeter (for a white background)?

I am trying to understand the differences between `EdgeDetect` and `MorphologicalPerimeter` (while researching this other question). I understand that, if the image background is not white, they will yield completely different results: ![enter image description here](http://i.stack.imgur.com/VGsRL.png) However, I am not sure whether they are guaranteed to return the same result if the background is white. In my tests, they do: ![enter image description here](http://i.stack.imgur.com/I46Wz.png) Could someone confirm this conclusion, or show a counter-example?


Can Wolfram System Modeler models be published in CDFs?

Is it possible to publish or distribute Models generated with WSM in CDF format (to interested people that do not have Mathematica and/or WSM)


Specifying a graphics object for the width of a median marker

In a previously posted question VLC used the element specification               {"MedianMarker", filledCircle[10], Black}      in a box and whisker chart, where               filledCircle[size_] := Graphics[{Black, Disk[]}, ImageSize -> size]      VLC was dissatisfied with the way the his filled circles were displayed in the resulting chart. Two answers were offered and there was some lively discussion in the comments. Strangely there was an elephant in the post and nobody noticed it. According to the _Mathematica_ documentation on `BoxWhiskerChart`, the second element in a MedianMarker specification is a **number** specifying the width of the horizontal line used to draw the median marker. There is no indication that a function application evaluating to a graphics object is acceptable. Thus my questions: Why does what VLC did work at all? Has he discovered a undocumented feature?


How to do equality check of a large matrix and get the corresponding index position?

Say I have a matrix A = 1000 x 5, and I want to compare it's first element (uppermost top left) to each of the 5 elements in the first column of matrix B of size 5 x 5. Whenever the first time the equality is flagged to say element of A is less than or equal to the element in B, the corresponding row position of B will be printed, and procedure is repeated with the next element down in A again compared with the same column of B. Similarly, elements in second column A will compare with second column of B, third column of A, compared with third column of B. This is repeated for the whole matrix of 5000 elements in A. So essentially the output matrix C will be of size 1000 x 5, with values ranging from 0 to 5. Or is this easier in VBA or Matlab?


Testing for primality in quadratic rings?

Testing for primality in $\mathbb{Z}[\sqrt{-1}]$ in Mathematica is easy:               PrimeQ[n, GaussianIntegers -> True]      But how can I test for primality in, say, $\mathbb{Z}[\sqrt{-7}]$? I'm interested in a large number of quadratic rings, not just that one. * * * I'll try to be more specific in case it helps. Of course much of the work is exploratory but some things remain roughly constant. $n$, the number to be tested for primality, is roughly 10 digits long. $d$ is almost always from 13 to 50, and in any case not more than a thousand. I tried to express the problem $$ p=(a+b\sqrt{-d})(c+e\sqrt{-d}) $$ as a Diophantine equation to use Mathematica's general solving tools, but they seem to not be up to the task. Using               f[d_, p_] := FindInstance[a c - b d e == p && a e + b c == 0 && a^2 + b^2 > 1, {a, b, c, e}, Integers]      I get > FindInstance::nsmet: The methods available to FindInstance are insufficient > to find the requested instances or prove they do not exist If I use               f[d_, p_] := Resolve[Exists[{a, b, c, e}, a c - b d e == p && a e + b c == 0 && a^2 + b^2 > 1], Integers]      the program runs forever (or at least more than half an hour; the analogous calculation on PARI/GP takes about 2 milliseconds). Finally               f[d_, p_] := FullSimplify[Reduce[{a c - b d e == p, a e + b c == 0, a^2 + b^2 > 1}, {a, b, c, e}, Integers]]      returns the result unsimplified.


How to generalize a formula?

This is a piece of my code:               der[g_, x_, n_] := Sum[g[k, g[0, x]] BellY[n, k,               Table[g[i, x], {i, n - k + 1}]], {k, 0, n}]     g[0, x] := x     g[1, x] := x     g[2, x_] := Evaluate[der[g, x, 2 - 1]]     g[3, x_] := Evaluate[der[g, x, 3 - 1]]     num := 4     Expand[der[g, x, num]]      It works up to `n=4`. I want to make it work for higher `n`. But trying to define                   g[n_, x_] := Evaluate[der[g, x, n - 1]]      returns error. What should I do?


How to select and delete all Output cells?

How to select and delete all Output cells in multiple notebooks **programmatically** without needing to (manually) opening them? How to define a hot key for deleting all Output cells within a notebook from that notebook?


Find all the last weekends in a year

In order to obtain the weekends of a year you'd use something like this:               With[{first = Take[DateList[], 2]},          DayRange[first, DatePlus[first, {{1, "Year"}, {-1, "Day"}}], "Weekend"]]      What I try to find out is how to either formulate this query in order to extract all the dates which are the last weekends of each month or through post-processing of the result. One problem that occurs is that there are months with four weekends and some with five. Another issue is the case of August where the last weekend is reaching into September. **Formulation of a possible algorithm (post-processing)**   1. Partition the list into sublists of size two and group every month   2. If the length of month is 1 = length mod 4, extend this sublist with the first element of the next month    3. Group all the last elements of the sublists I'd know exactly how to do that in C/C++ but alas still lack enough Mathematica skills. Any help is welcome.


Transform vector with lag

Say I have a vector $Z_n$ with and I want to transform it into another vector using this formula: $X_t=Z_t+0.7Z_{t-2}$ The problem is that I am not quite sure how to get that $t-2$ lag in there. I see how I could do it with a `For` loop but that doesn't seem like a very Mathematica way of doing it.


DatabaseLink`: MySQL query with client/server compression

I'm trying to reduce transfer time when accessing rows of a mysql table over a network, where each row has a lot of data. Is there a way to enable client- server compression when accessing a mysql database via ``DatabaseLink```? As a workaround, I could request a column with `COMPRESS(column_with_lots_of_data)` in my `SQLExecute` query, but it is not clear how to uncompress the result on the Mathematica side.


How to select elements in a tensor conditional upon their indices

I have a tensor, u, of rank one, meaning that I have a matrix whose elements are themselves matrices. I would like to select, and make a list of, only those sub-matrices whose indices comply with the condition `j < k`, i.e. the row index is always smaller than the column index. This effectively corresponds to strictly _upper-triangularising_ the tensor. Once I select the correct sub-matrices, I would like them to appear in a list sorted row by row. I.e., if each sub-matrix is called `aXX`, where `XX` are the row and column indices, and the tensor has dimensions `NxN`, then I want the list to look like this:               a12, a13, a14 ..., a1N, a23, a24, ..., a2N, a34, ..., a3N, ..., a(N-1)N.      I have tried using `UpperTriangularize[]` to no avail. I suspect the answer must be using `Select[]` or `Pick[]`, but I am unsure of how to implement the condition based on testing the indices of the tensor. Any ideas would be much appreciated. Here is my code which generates u. `NLevel` is the same as `N` that I mentioned above, and can be varied with each run of the programme.                P = Table[SparseArray[{{j, k} -> 1}, {NLevel, NLevel}], {j, NLevel}, {k, NLevel}]      u = Table[P[[1, j, k]] + P[[1, k, j]], {j, NLevel}, {k, NLevel}]


LayeredGraphPlot: two instances of the same label

What I'd like to do is to have the same label more than once in the plot. I.e. I do not want the edges to direct toward the first instance of that label! For example:               LayeredGraphPlot[{1 -> 2, 1 -> 3, 2 -> 3, 1 -> 4, 2 -> 4, 3 -> 2}, VertexLabeling -> True]      ![enter image description here](http://i.stack.imgur.com/GxgdN.jpg) I want 3 -> 2 (a new 2)! How can this be achieved?


Plotting query - same values on Y-axis / viewing data

I'm new to Mathematica, and have numerically solved two similar functions with the following code;               a = 5.9336*10^-6; ro = 500*10^-6; Do2 = 2*10^-9; f =       2.6835*10^-7; po = 100;           rl = Sqrt[(6*Do2*f*po)/a];     rn = ro (0.5 - Cos[(ArcCos[1 - (2*rl^2)/(ro^2)] - 2*Pi)/3]);     k = 1*10^-6;          sol = NDSolve[{a*C[r] == (C''[r] + (2/r) C'[r]) (C[r] + k),          C[ro] == f*po, C'[rn] == 0}, C, {r, rn, ro}];          solreal = NDSolve[{a == (Creal''[r] + (2/r) Creal'[r]), Creal[ro] == f*po,          Creal'[rn] == 0}, Creal, {r, rn, ro}];          Plot[Evaluate[{(C[r]/f) /. sol, (Creal[r]/f) /. solreal} ], {r, rn,        ro}, PlotRange -> All]      However, I have TWO problems; one is that even though the functions are increasing along the x-axis, the values of the Y-axis are all displaying the exact same number (100). Any idea why this is? Secondly, can I some how open the array of values for these functions to look at what they are at specific points? Sorry if these are obvious questions!


how recover lost data of coordinates from contourplot of mention data?

I have made `Contour Plot` for a lot of data, like this               ListContourPlot[ data, DataRange -> {{yMin, yMax}, {xMin, xMax}},                       AxesLabel -> {"y", "x"}, PlotRange -> All,                       PlotLegends -> Automatic, ColorFunction -> "BlueGreenYellow"]      ![enter image description here](http://i.stack.imgur.com/mFpH1.jpg) but now I lost my data (the coordinates). How I can recover those in such way that I can plot them by:               ListContourPlot[recovereddata]      or preferably               ListContourPlot[ recovereddata, DataRange -> {{yMin, yMax}, {xMin, xMax}},                      AxesLabel -> {"y", "x"}, PlotRange -> All,                       PlotLegends -> Automatic, ColorFunction -> "BlueGreenYellow"]


Export all open notebooks and change font size

Is there a simple way to export all open notebooks to pdfs? Also, when I export notebooks the font looks too big / the margins are too big. Can I change these settings when exporting?


How to save data to a variable by clicking a button, using Widget Panel

In Mathematica I am trying to implement algorithm, for which I would like to have user friendly interface, I have managed to create Panel using Widgets, but when I am trying to provide the value of the textfield with clicking the Submit button, nothing happen. I have created the following event: > BindEvent["action", Script[buttonClicked[]] so when the button is clicked buttonClicked[] should be executed, which contains check on the textfield. But nothing happen when clicking Submit. Could you please give me a hand on that.               Needs["GUIKit`"];     ref = GUIRun[Widget["Panel",             {Widget[          "Label", {"text" ->             "Please provide the following coefficients:"},          WidgetLayout -> {"Alignment" -> Center}, Name -> "mainLabel"],              WidgetSpace[10],         {Widget["Label", {"text" -> "  Value for p1"}],          Widget["TextField", {"columns" -> 6}, Name -> "p1_tf"],          Widget["Label", {"text" -> "            "}]          },         WidgetSpace[10],         {WidgetFill[],           Widget["Button", {"text" -> "Submit",             BindEvent["action", Script[buttonClicked[]]]},            Name -> button1], WidgetFill[]          }         }        ]]          ImaginaryQ[expr_] := ! FreeQ[expr, _Complex];          Script[      buttonClicked[] := (If [          ImaginaryQ@p1_tf ==            False, {MessageDialog [             "The provided value is not valid. You need to enter complex value"], Exit[]}];)         ]          GUIScreenShot[ref];          p[[1]] = p1_tf; (*p1*)       Print["p1=", p[[1]]];


Changing the speed of exported AVI videos

I am exporting an animation created using `Manipulate` in the `.avi` format. However the video runs very fast (I am putting it in Keynote). Its speed seems independent of how small I choose the step in `Manipulate`. Is there a way to control how fast the `.avi` will run or some other way to show the animation slower?


Manipulate and ExclusionsStyle

How can I change `ExclusionsStyle` for a plot inside `Manipulate`? Here's a sample that (though it shouldn't) seems to produce equivalent result to `ExlusionsStyle->{None}`:               Manipulate[     Plot[{1/(a - x), x/(x - b)}, {x, -10, 10},     Exclusions -> {b, a}, ExclusionsStyle -> {Dashed}], {a, -10, 10}, {b, -10, 10}]


Intersection does not take list of lists

The function `Intersection` takes a number of lists (sets) and finds their intersection. However, the precise input is `Intersection[{1, 1, 2, 3}, {3, 1, 4}, {4, 1, 3, 3}]` and not `Intersection[{{1, 1, 2, 3}, {3, 1, 4}, {4, 1, 3, 3}}]`. This means I am having difficulty automatising my procedure using `Table`. For example, I wish to first construct `myInput=Table[i+j,{i,1,5},{j,1,8}]` and then `Intersection[myInput]`. This does not work, and `Flatten` doesn't seem to be able to flatten at level `0`. Any help? Thanks!


Issue with Grid command

![enter image description here](http://i.stack.imgur.com/0CDy3.png) Dear all, I've been trying to set prepare a grid with different charts for comparisons. The issue I have is that the first row of the grid has the legend distorted. The issue does not occur for subsequent rows. (see the elongated legend boxes?). I defined a function to create a combination of two charts, then created a grid and exported it to pdf.               chartTrends[country_, percent_] := Module[       {a, b},       a = salesTrend[country, percent];       b = Table[         Labeled[Last[a][[i]],           If[Mod[i, 4] == 1, Rotate[headings[[i]], 90 Degree], None]], {i,           Range@Length@headings}];       Grid[{{BarChart[b, ChartLayout -> "Percentile",            ChartStyle -> ColorData[35, "ColorList"],            PlotRegion -> {{0.10, 0.90}, {0.10, 0.90}}, ImageSize -> 1000,            ChartLegends ->             Placed[Style[#, FontSize -> Small] & /@ First[a], Right]],           BarChart[b, ChartStyle -> ColorData[35, "ColorList"],            PlotRegion -> {{0.10, 0.90}, {0.10, 0.90}},            ChartLayout -> "Stacked", ImageSize -> 1000]}} ]]      This is what I used to create the grid and export it to pdf.               myGrid = Grid[         Partition[         Column[{"", Style[#, Bold, FontSize -> 36], "",              chartTrends[#, 0.9]}, Alignment -> Center] & /@ countryList,          4], Alignment -> Center, Frame -> All,         FrameStyle -> Directive[LightGray]];     Export["myGrid2.pdf", myGrid]      I've tried with GraphicsGrid instead of Grid, but that creates other problems such as cropping the legend box. Any clues?


CDF plug-in and animation controls

I've read through all the Q and A on the CDF plug-in and still am puzzled. I've managed to create some webpages with CDF content, it's working fine except when you reveal the animation menu and use the input field instead of the slider. If you type anything in the input field, the demonstration is no longer viable and you need to refresh the page to get it working again. The demonstrations at the main site don't have this issue. Is there something I can do to prevent this from happening? And is it possible to get numeric input in this way? Here is an example. My skills are limited so maybe this requires lots of checking of input values to insure they match the constraints of the demonstration?


Linear interpolation between defined anchorpoints in an array (where anchorpoints are set each time we see a new element)

This question is an update and a correction my earlier question: Linear interpolation of a list between periodic anchorpoints (which was nicely answered). Imagine I have a list of the form:               list = {1,1,1,2,2,2,3,3,3,4,4,4,7};      Where we can see that there are an ordered set of integer or real numbered values that repeat themselves some fixed number of times N. Is there a nice one-liner to transform this list into something like:               modifiedList = {1,1+1/3,1+2/3,2+1/3,2+2/3,3,3+1/3,3+2/3,4,5,6,7}      Where each time we see a new value we place an anchorpoint, and then "fix" the points in the array between these anchorpoints so that they lie on a line between successive anchorpoints?


Image Processing Mag and Phase Spectrum of Sobel, Roberts Mask

How to find the Magnitude and Phase Spectrum of Sobel, Roberts etc. etc. Mask of Image Processing using MATHEMATICA 9.0 platform....


How to extract strings from the list with an additional condition on previous elements?

There are a long list of strings $s$ and two lists of substrings $s1$ and $s2$. I want to take all elements of $s$ which contain a substring from $s2$ and such that before it on no more than $n$ places there is a string containing a substring from $s1$. For example, if               s={"a","b1","c","b2","a","c","b3"};     s1={"a"} ;     s2={"b"};     n=2;      the result should be `{"b1","b3"}` because two previous to `"b2"` elements don't contain substring `"a"`. It can be done with the help of `Position`, creating and comparing two lists of elements positions with fragments from $s1$ and $s2$. Is there a more direct way without creating additional lists?


Extract X value from corresponding Y value from a List or Transpose

I have a list of X values and Y values separately, and also together with:               data=Transpose[{X,Y}]      This data is from a chromatogram, and I want to extract the retention time tR (X) that corresponds to the highest value of absorbance (Y). I normally perform an interpolation with               f=Interpolation[data];     tR=x/.Last[FindMaximum[f[x],{x,1}]];      For some reason this approach is not working with a recent chromatogram, and I wanted to extract the X value that corresponds to the maximum Y value directly from the two lists like this:               Position[Y,Max[Y]]      This gives me the position in the vector where I can find the X value I want. If I input the value manually I get the X value I am looking for:               X[[9970]]      So far so good. However, if I try to assign Position[Y,Max[Y]] to a variable (for automation, since I have a program that does all the data extraction and plotting for me), I cannot get the X value:               ymaxposition=Position[Y,Max[Y]];     tR=X[[ymaxposition]]      > Part::pspec: Part specification {{9970}} is neither a machine-sized integer > nor a list of machine-sized integers. >> This isn't working either:               Position[Y,Max[Y]]     tR=X[[%]]      Any help will be very welcome.