Why only up to two \[Prime] superscripts are interpreted as derivatives?

I noticed that only up to two `\[Prime]` superscripts are interpreted as derivatives. Is there a reason for this restriction? Is it documented?               \!\(\*SuperscriptBox["Sin","\[Prime]"][x]\)     (* Cos[x] *)          \!\(\*SuperscriptBox["Sin","\[Prime]\[Prime]"][x]\)     (* -Sin[x] *)          \!\(\*SuperscriptBox["Sin","\[Prime]\[Prime]\[Prime]"][x]\)     (* (Sin^\[Prime]\[Prime]\[Prime])[x] *)      * * * ![Screenshot](http://i.stack.imgur.com/pOSgF.png) * * * The regular apostrophe can be used any number of times though:               Sin'''[x]     (* -Cos[x] *)


How can I add arbitrary code into DefaultKeyTranslations.tr?

The solution to this question on how to get latex code for a text cell (which Mathematica doesn't do correctly) was formulated as a palette but I need it as a keyboard shortcut. How can I add an item to DefaultKeytranslations.tr that executes this solution's code? And in general, how does one construct a key command that executes arbitrary code, not just front-end packets and tokens?


Triple series - evaluation delayed

Trying to figure out if the infinite triple series has a nice closed form. It seems _Mathematica_   is unable to help us here. Numerically, things remain the same, no response. Could you help?               N[ Sum[ n! k! m!/(n + k + m + 2)!, {n, 0, ∞}, {k, 0, ∞}, {m, 0, ∞}]]      **EDIT** : in 2 variables, the double series evaluates to $\pi^2/6$.


Anti-aliasing with the multiple-object form of Polygon?

Observe:               rand = RandomReal[1, {4, 3, 2}];          Graphics @ Polygon @ rand      ![Mathematica graphics](http://i.stack.imgur.com/dZ1JA.png)               Graphics[Polygon /@ rand]      ![Mathematica graphics](http://i.stack.imgur.com/HIizb.png) I am losing anti-aliasing when I use the multiple-polygon syntax form of `Polygon`. Yet it is possible for _Mathematica_ to apply AA as can be shown with:               Style[      Graphics @ Polygon @ rand,      Antialiasing -> True     ]      (Incidentally this `Style`-applied AA does not copy with Szabolcs's Image Uploader but the in-Notebook appearance is identical to the second output above.)   * Why am I losing anti-aliasing here?   * Is there a system option to turn it on, and with what caveat?


Trying to combine an image with a Plot

I've got this picture: ![JuliaSet](http://i.stack.imgur.com/NLMXG.png) The image has a resolution of 2001x2001. The left most pixel has an x-value of -2, and the right most pixel has an x-value of 2. Same goes for the y-values. Now I am trying to load this image into _Mathematica_ and get it on the right scale inside a graphics environment. I've tried using inset like this:               julia = Import["http://i.stack.imgur.com/NLMXG.png"];     Graphics[{Blue, Rectangle[{-2, -2}, {2, 2}],          Inset[julia, Center, Center, 4]}, PlotRange -> {{-3, 3}, {-3, 3}},        Axes -> True, AxesStyle -> Orange]      ![](http://i.stack.imgur.com/m2rhH.png) This still gives a little blue border around some sides, giving me the impression that it is not centered properly. Is there a better way to do this?


Image Shadow Removal in Mathematica

The task is: ![enter image description here](http://i.stack.imgur.com/rSOow.png) **Image shadow removal** is an important topic in image processing. If you feel curious about it, you may take a look **here**, or just google for it **image shadow removal** There are also a few questions on SE around it. For example:   * http://dsp.stackexchange.com/questions/2247/how-can-i-remove-shadows-from-an-image   * http://stackoverflow.com/questions/9081930/how-to-remove-the-shadow-in-image-by-using-opencv However, I did not find any Mma implementations out there, and I don't want to reinvent the wheel if it is already rolling. Does anybody know of some Mma codebase for using it as a starter? Note: I have to do this for a few images, so I may go the manual way better than spend many hours in developing a full blown algorithm.


Overlay Rectangle on a ListPlot

I have a ListPlot of 100 data points in the range of 0 and 1. Now I'm trying to find a way to overlay (four) rectangles onto the listplot in 0.25 steps horizontally. Essentially I just have BinLists and try to visualize the Bins on the ListPlot with rectangles. I drew a nice little picture with paint (since I can't draw it in mathematica yet :)) which hopefully makes it a little more clearer..I only drew three rectangles.. ![enter image description here](http://i.stack.imgur.com/XSqXE.png) It seems somehow complicated to me and I don't get it to work (except with paint ^^), can someone help me out?


Fix Parameters for NonLinearModelFit?

Is it possible to fix the parameters for `NonLinearModelFit` within the function itself instead of defining the fix parameters at the beginning of the notebook? I am fitting multiple sets of data with the same function and certain parameters go to zero in some of the data sets. Fixing them to zero inside the function would be a lot easier than constantly changing which parameters are being used to fit the data.


Finding all maxima and minima of a function

To find all (global and local) extrema of a function in R3 I have written: Example-function               n = 2.;          terrain[x_, y_] :=  2 (2 - x)^2 Exp[-(x^2) - (y + 1)^2] -        15 (x/5 - x^3 - y^3) Exp[-x^2 - y^2] - 1/3 Exp[-(x + 1)^2 - y^2];          fun = terrain[x, y];          plot = Plot3D[fun, {x, -n, n}, {y, -n, n}, PlotRange -> All, ColorFunction -> "DarkTerrain", Mesh -> False, PlotStyle -> Opacity@0.7]      ![enter image description here](http://i.stack.imgur.com/Xw8LZ.jpg) One can observe 3 maxima and 3 minima.               NMaximize[fun, {x, y}]      > {6.4547, {x -> -0.3593, y -> -0.5519}} And               FindMaximum[fun, {x, y}]      > {6.1972, {x -> -0.0529, y -> 1.2130}} return two of the maxima but miss the third. My idea then was to map `NMaximize`over "sufficient sectors" of the function:                p = Flatten /@ Tuples[Partition[Range[-n, n], 2, 1], 2]      > {{-2., -1., -2., -1.}, {-2., -1., -1., 0.}, ... , {1., 2., 1., 2.}} (This algorithm was kindly provided by Kuba) The next steps are:               max1 = NMaximize[{fun, p[[#, 1]] <= x <= p[[#, 2]], p[[#, 3]] <= y <= p[[#, 4]]}, {x, y}] & /@ Range@Length@p;     max2 = Chop@Partition[Cases[max1, _Real, Infinity], 3];      The result contains wrong points at the edges of the sectors which can be deleted with               filter = # || (# /. b -> c) &[Or @@ MapThread[Equal, {Table[b, {n*2 + 1}], Range[-n, n]}]]      > b == -2. || b == -1. || b == 0. || b == 1. || b == 2. || c == -2. ||   >  c == -1. || c == 0. || c == 1. || c == 2.               max3 = DeleteCases[max2, {_, b_, c_} /; Evaluate@filter]      > {{6.45471, -0.359311, -0.551929}, {6.19724, -0.0529807, 1.21301}, {5.4426, > 1.26211, -0.0152309}} now gives us the three maxima.               maxpoints = Graphics3D[{PointSize@0.05, Point /@ RotateLeft /@ max3}]      Repeating max1 through max3 with NMinimize finally gives this image: ![enter image description here](http://i.stack.imgur.com/fvtco.jpg) Summing - up:               extrema[foo_, maxmin_, color_] :=      Module[{res},       res = maxmin[{foo, p[[#, 1]] <= x <= p[[#, 2]],             p[[#, 3]] <= y <= p[[#, 4]]}, {x, y}] & /@ Range@Length@p;       res = Chop@Partition[Cases[res, _Real, Infinity], 3];       res = DeleteCases[res, {a_, b_, c_} /; Evaluate@filter];       Graphics3D[{color, PointSize@0.05, Point /@ RotateLeft /@ res}]]          Show[plot, extrema[fun, NMaximize, Black],       extrema[fun, NMinimize, Red], ViewPoint -> {0, 0, Infinity}]      Although my approach works, it is pretty slow (more than 2 seconds to find the extrema), and, having found it only by trial and error, I am not sure if this solution is general enough. I would welcome any comments how to improve on this.


Can Mathematica automatically take advantage of the GPU on the new Mac Pro?

I'm upgrading my Mac to one of the new Mac Pro R2D2 Darth Vader models that have just been released. They come standard with twin AMD FirePro D300 cards, or twin D500 cards. I don't need that much graphics processing power, and since I understand the D500 puts out a lot more heat than the D300, and I really don't like fan noise ... I was going to go for the D300s. However, Apple's Mac Pro blurb says: > The FirePro D500 supports fast double-precision computations, executing at > one-quarter the performance of single-precision floating point rather than > the 1/16 performance seen in the D300 and most consumer GPUs And this got me wondering: If GPUs support double precision numerics, is it possible currently (or in the works??) for _Mathematica_ to AUTOMATICALLY take advantage of the massive teraflop GPU power for numerical computations? I don't want to have to specially load CUDALink libraries or to write special code or to specially load OpenCL functions … I just want to use standard _Mathematica_ functions. In brief: Can _Mathematica_ automatically take advantage of the new Mac Pro GPU for numerical calculations? If not, I think I'll stick with the quieter, cooler D300 GPU, … and max something else out! * * * Addendum: Apple's new Autovectorizer in OSX Mavericks https://developer.apple.com/library/mac/documentation/Performance/Conceptual/OpenCL_MacProgGuide/AutoVectorizer/AutoVectorizer.html#//apple_ref/doc/uid/TP40008312-CH7-SW1 > Using OpenCL is easier than ever as of OS X v10.7: The autovectorizer allows > you to write one kernel that runs efficiently on both a CPU and a GPU. You > can invoke the autovectorizer regardless of whether you are compiling from > Xcode or building the kernels at runtime.


How to control format options of an exported animation?

My woes with Mathematica animations exported in SWF-format continue. The goal is to Export an animation in SWF-format, and also make it scalable, so that when I embed it into a slide set (produced by LaTeX) in PDF-format, the animation will resize when I zoom in/out. I have asked a related question on TeX.SE, where a solution via converting the animation into an MP4-file was suggested. That solution works, but lossy compression (or something) makes the end result look passable but not nearly as good as the same animation in a Mathematica notebook. Following the further discussion in TeX.SE I looked at the header of the generated SWF-file with a text editor (NotePad). Indeed, there reads `scaleMode - noScale`. So time to study Mathematica's help files. Promising sounding options are listed in `ref/format/SWF`. Most notably _Scalable_ and _ControlAppearance_ (kind of pointless to have those unclickable control buttons in the end product). So let's try...               roll[u_] := Show[       {ParametricPlot[{Cos[t] + u, Sin[t] + 1}, {t, 0, 2 Pi},          AspectRatio -> Automatic, AxesOrigin -> {0, 0},          Ticks -> {{0, 2 Pi, 4 Pi, 6 Pi}, {}}],        ParametricPlot[{u, 1} - t {Sin[u], Cos[u]}, {t, 0, 1}],        ParametricPlot[{t - Sin[t], 1 - Cos[t]}, {t, -0.6, u}],        Graphics[{PointSize[0.02], Point[{u - Sin[u], 1 - Cos[u]}]}]},        PlotRange -> {{-1.2, 20}, {-0.2, 4.2}}, Axes -> True]          sykloidi = Animate[roll[u], {u, 0, 20}]          Export["Analyysi I/2013/kalvot12-13/sykloidi.swf", sykloidi,       AnimationDuration -> 6, FrameRate -> 8, Scalable -> True,       ControlAppearance -> None]      Nope. No change. The .swf still does not scale. In the header of the SWF-file it still reads `scaleMode - noScale`, and the control buttons didn't disappear either. > Did I use wrong syntax for `Export` in the above snippet? What's the right > way of doing this?


Can't find where to download VEST package for Mathematica

In the Internet I have found the article about the VEST package for abstract vector calculus simplification in Mathematica. http://arxiv.org/abs/1309.2561 However, I can not find any reference for downloading this package. Does anybody know where I can download this package?


Why does Dynamic for PlotRange in ListLinePlot prevent the proper range from being used?

I am using `Manipulate` to simulate Brownian motion. I want to be able to zoom in. Thus, I want to use `Dynamic` for the `PlotRange` option so that this can be done quickly without recomputing the motion. It works properly without `Dynamic` (except for speed), but using `Dynamic` changes its operation so that the range is no longer what I ask for once I zoom in sufficiently. See this by changing the "horizontal zoom". I also have the same `PlotRange` in Show. It seems I need both. No doubt I am not doing other things optimally, but this issue is a separate problem. Here is my code, first without the first `Dynamic` and second with it. At the end is a smaller example. It behaves differently, but again the behavior depends on whether PlotRange has Dynamic or not. This last example contains both types of code in it. It comes in two forms, one using Show and one not.               Manipulate[     Module[{bmPath, iterate}, SeedRandom[seed];      iterate[l_List] :=      Module[{i = 1, len = Length[l], new = l},      While[i < Length[new],       new = Insert[        new, (new[[i]] + new[[i + 1]])/2 +          RandomVariate[NormalDistribution[0, .5/Sqrt[(len - 1)]]],         i + 1]; i = i + 2]; new];      bmPath = {0, RandomVariate[NormalDistribution[0, 1]]};      Do[bmPath = iterate[bmPath], {n}];      Show[ListLinePlot[bmPath, AxesLabel -> {"Time", "Location"},      DataRange -> {0, 1},      PlotRange -> {Clip[{hcenter - 2^(-zoom), hcenter + 2^(-zoom)}, {0,          1}], vcenter + {-2, 2}/2^(scale/2)}],      Plot[{Sqrt[x], -Sqrt[x]}, {x, 0, 1},      PlotStyle -> If[bound, Dotted, Opacity[0]]],      PlotRange ->      Dynamic[{Clip[{hcenter - 2^(-zoom), hcenter + 2^(-zoom)}, {0, 1}],        vcenter + {-2, 2}/2^(scale/2)}],      AxesOrigin -> Dynamic[{hcenter, vcenter}],      ImageSize -> {475, 360}]],     {{n, 10, "detail"}, 1, 40, 1, Appearance -> {"Labeled", "Open"},      AnimationRate -> rate}, {{rate, 1, "rate"}, 1, 3, 1,      Appearance -> "Labeled"}, {{bound, False,      "show sqrt bounds"}, {True, False}}, Delimiter, {{hcenter, .5,      "horizontal center"}, 0, 1, .01/2^(zoom - 1),      Appearance -> {"Labeled", "Open"},      AnimationRate -> .2/2^(zoom - 1)}, {{vcenter, 0,      "vertical center"}, -3, 3, .01/2^(scale - 1),      Appearance -> {"Labeled", "Open"},      AnimationRate -> .1/2^(scale - 1)}, Delimiter, {{zoom, 1,      "horizontal zoom"}, 1, 20, 1,      Appearance -> {"Labeled", "Open"}}, {{scale, 1,      "vertical scale"}, -2, 20, 1,      Appearance -> {"Labeled", "Open"}}, Delimiter, {{seed, 77777,      "new random case"}, 10000, 999999, 1, Appearance -> "Open",      AnimationRate -> newrate}, {{newrate, 1, "rate of new case"}, 1, 10,     1, Appearance -> "Labeled"},     ControlPlacement -> Right, SynchronousUpdating -> False]               Manipulate[     Module[{bmPath, iterate}, SeedRandom[seed];      iterate[l_List] :=      Module[{i = 1, len = Length[l], new = l},      While[i < Length[new],       new = Insert[        new, (new[[i]] + new[[i + 1]])/2 +          RandomVariate[NormalDistribution[0, .5/Sqrt[(len - 1)]]],         i + 1]; i = i + 2]; new];      bmPath = {0, RandomVariate[NormalDistribution[0, 1]]};      Do[bmPath = iterate[bmPath], {n}];      Show[ListLinePlot[bmPath, AxesLabel -> {"Time", "Location"},      DataRange -> {0, 1},      PlotRange -> Dynamic[{Clip[{hcenter - 2^(-zoom), hcenter + 2^(-zoom)}, {0,          1}], vcenter + {-2, 2}/2^(scale/2)}]],      Plot[{Sqrt[x], -Sqrt[x]}, {x, 0, 1},      PlotStyle -> If[bound, Dotted, Opacity[0]]],      PlotRange ->      Dynamic[{Clip[{hcenter - 2^(-zoom), hcenter + 2^(-zoom)}, {0, 1}],        vcenter + {-2, 2}/2^(scale/2)}],      AxesOrigin -> Dynamic[{hcenter, vcenter}],      ImageSize -> {475, 360}]],     {{n, 10, "detail"}, 1, 40, 1, Appearance -> {"Labeled", "Open"},      AnimationRate -> rate}, {{rate, 1, "rate"}, 1, 3, 1,      Appearance -> "Labeled"}, {{bound, False,      "show sqrt bounds"}, {True, False}}, Delimiter, {{hcenter, .5,      "horizontal center"}, 0, 1, .01/2^(zoom - 1),      Appearance -> {"Labeled", "Open"},      AnimationRate -> .2/2^(zoom - 1)}, {{vcenter, 0,      "vertical center"}, -3, 3, .01/2^(scale - 1),      Appearance -> {"Labeled", "Open"},      AnimationRate -> .1/2^(scale - 1)}, Delimiter, {{zoom, 1,      "horizontal zoom"}, 1, 20, 1,      Appearance -> {"Labeled", "Open"}}, {{scale, 1,      "vertical scale"}, -2, 20, 1,      Appearance -> {"Labeled", "Open"}}, Delimiter, {{seed, 77777,      "new random case"}, 10000, 999999, 1, Appearance -> "Open",      AnimationRate -> newrate}, {{newrate, 1, "rate of new case"}, 1, 10,     1, Appearance -> "Labeled"},     ControlPlacement -> Right, SynchronousUpdating -> False]               Manipulate[     Module[{bmPath}, bmPath = {0, 2, 1};      Row[{ListLinePlot[bmPath, AxesLabel -> {"Time", "Location"},       DataRange -> {0, 1},       PlotRange ->        Dynamic[{Clip[{.5 - 2^(-zoom), .5 + 2^(-zoom)}, {0, 1}], {-2,           2}}], ImageSize -> {200, 100}],      ListLinePlot[bmPath, AxesLabel -> {"Time", "Location"},       DataRange -> {0, 1},       PlotRange -> {Clip[{.5 - 2^(-zoom), .5 + 2^(-zoom)}, {0,           1}], {-2, 2}}, ImageSize -> {200, 100}]}]],     {{zoom, 1, "horizontal zoom"}, 1, 20, 1,      Appearance -> {"Labeled", "Open"}},     ControlPlacement -> Right, SynchronousUpdating -> True]               Manipulate[     Module[{bmPath}, bmPath = {0, 2, 1};      Row[{ListLinePlot[bmPath, AxesLabel -> {"Time", "Location"},       DataRange -> {0, 1},       PlotRange ->        Dynamic[{Clip[{.5 - 2^(-zoom), .5 + 2^(-zoom)}, {0, 1}], {-2,           2}}], ImageSize -> {200, 100}],      Show[ListLinePlot[bmPath, AxesLabel -> {"Time", "Location"},        DataRange -> {0, 1}],       PlotRange ->        Dynamic[{Clip[{.5 - 2^(-zoom), .5 + 2^(-zoom)}, {0, 1}], {-2,           2}}], ImageSize -> {200, 100}]}]],     {{zoom, 1, "horizontal zoom"}, 1, 20, 1,      Appearance -> {"Labeled", "Open"}},     ControlPlacement -> Right, SynchronousUpdating -> True]


Plotting a function dependent on $x/d$

I have a problem in plotting a function. The example code is as following:               d = 0.1;     M[x_] := ((x/d) - 0.4);     Plot[p[x], {x, 0, 10}, Ticks -> {{0, d, 2d, 3d}, {1, 1}}]       I would like to have $d,\ 2d,\ 3d$ and so on the x-axis label at right positions, i.e. at $0.1,\ 0.2$ and so on. How can I achieve this?


Deformed style when exporting eps files

I want to export a plot into an eps file. Below I present a sample plot code in order to demonstrate the two issues that appear. (1). `LabelStyle`: When I use "Times" or "Helvetica" style all seem to work fine. However, when I choose "Traditional" or "Tahoma" the style of the labels in the exported eps file is horribly deformed. This happens regardless the procedure I use; using the `Export` command or choosing the plot and then form `File -> Save Selection As ...` (2). Capital Greek letters: I use the capital Greek letter `Theta` for the label of the y-axis. However, I discovered that many capital Greek letters are also deformed in the exported eps or pdf file. Many thanks in advance and I look forward for your replies and comments               S1 = Plot[Exp[-x]*Sin[7*x], {x, 0, 5}, Axes -> False, Frame -> True,       FrameLabel -> {"x", "Θ(x)"}, RotateLabel -> False, PlotStyle -> Red,       LabelStyle -> Directive[FontSize -> 17, FontFamily -> "Helvetica"],       PlotRange -> All, ImageSize -> 500]           Export["Plot.eps", S1]      * * * Thank you very much for all your replies and I am really very sorry for not responding sooner. I am using the latest version 9.0 of Mathematica in Windows XP SP3. However, the same issues appear in older versions (8,7, ... , 4) which are also installed in my PC. Therefore, I suppose that the version is irrelevant. Below I present three exports using different format (eps, pdf and jpg). I used "Tahoma" style. First the .jpg output. All seems to be OK. ![enter image description here](http://i.stack.imgur.com/k4gh5.jpg) Then the .pdf output. Well, the Greek capital letter Theta is deformed. ![enter image description here](http://i.stack.imgur.com/zLfGE.png) And finally, the .eps output loaded in GSView 5.0. Here, not only the Greek letter but also the axis labels are deformed. However, if I convert the exported .eps file to .pdf with Adobe the axis labels are becoming normal as Fig. 2 but still the Greek letter is deformed. ![enter image description here](http://i.stack.imgur.com/3RHyC.png) If I am correct, I encounter an issue regarding fonts. So, I would be very grateful if you could suggest me some solutions to my problem.


How could I generate words starting with P,h,D?

A friend of mine is a PhD candidate and posted a picture on Facebook with funny words starting with 'p', 'h' and 'd' like "Please hire. Desperate" or "Permanent head Damage". I thought I could try and programmatically generate some word combinations with Mathematica. Here is my version. Most of the results are meaningless, but occasionally a good combination will show up like "panegyric happiness date".   1. Could it be improved (i.e. increase its signal/noise ratio)?   2. Could the following construct be condensed `{"." -> "", ";" -> "", "," -> "", ... -> ""`? Schematically: `{".", ";", ","} - >""`   3. The reason I used `StringMatchQ` with `Map[]` is because I didn't know how to group the results based on the first letter of the words, e.g. {please, hire, permanent, damage, head, desperate} -> {{please, permanent}, {hire, head}, {damage, desperate}}`. Also, I used words from `DictionaryLookup[]`, picking those with the most meanings (to increase the likelihood of a meaningful combination), but the results were worse. Here is my code:               ClearAll["Global`*"];          allWords =        ExampleData[{"Text", "PrideAndPrejudice"}, "Words"] // DeleteDuplicates;          phdWords = Pick[          allWords,          StringMatchQ[allWords, #]] & /@ {"p" ~~ __, "h" ~~ __, "d" ~~ __};          phdWords =       StringReplace[#,          {"." -> "", ";" -> "", "," -> "", "!" -> "", "?" -> "",            "\"" -> ""}] & /@ phdWords;          filterWordsByPart[wordList_, part_] :=       Select[        wordList,        MemberQ[          WordData[#, "PartsOfSpeech"], part] &];          finalWords = MapThread[        filterWordsByPart,        {phdWords, {"Adjective", "Noun", "Noun"}}];          Table[       Flatten@(RandomSample[#, 1] & /@ finalWords),       {20}] // Grid[#, Frame -> All] &      And this is a sample output: ![enter image description here](http://i.stack.imgur.com/EAVBP.png)


Group theory - symmetry inequivalent sqaure matrices with PBC

I would like to obtain the symmetry inequivalent possible occupations of indistinguishable objects in a square lattice with periodic boundary conditions. Examples:   * 1 object in a 4 by 4 square lattice has 16 **equivalent** positions -> **1 inequivalent position**.   * 2 objects in a 3 by 3 square lattice has 2 **inequivalent** positions.              000    000     000    010     110    100        * 2 objects in a 4 by 4 square lattice has 5 **inequivalent** positions.              0000    0000    0000    0000    0000     0000    0000    0000    0000    0010     0000    0000    0100    0010    0000     1100    1010    1000    1000    1000      ![Some equivalent positions in a 4x4 square lattice](http://i.stack.imgur.com/24MM6.jpg) I can search for the inequivalent positions with a bruteforce approach by applying all possible symmetries to all possible initial configurations of 1 or 2, 3 objects and so on. Anyway, I was wondering if there is a way to do this with group theory in Mathematica. I tried starting from this SO question but I didn't manage to get translations working. Thanks in advances.


problem with coloring spherical harmonics

I want to color a spherical harmonics. So I write as follows.               color[θ_, φ_] :=        RGBColor[(Sign[Re[SphericalHarmonicY[2, 1, θ, φ]]] + 1)/2, 0,                 (-Sign[Re[SphericalHarmonicY[2, 1, θ, φ]]] + 1)/2 ];     SphericalPlot3D[ Re[SphericalHarmonicY[2, 1, θ, φ]], { θ, 0, Pi}, {φ, 0, 2 Pi},                       ColorFunction -> Function[{x, y, z, θ, φ, r}, color[ θ, φ]]]      I expect that the output plot should show the parity of the spherical harmonics with red corresponding to the positive part and blue corresponding to the negative part. But the actual result is all Blue! ![spherical harmonic](http://i.stack.imgur.com/2kUi8.gif)


Slice through Graphics3D

is there any possibility to slice through a Graphics3D object? At the end I would like to have a stack of images slicing , e.g. $n$ times in $z$-direction: $((x,y,z_{0}), (x,y,z_{1}),…,(x,y,z_{n}))$ Here is an example of random spheres, which I would like to slice.               z = 100;     p = RandomReal[100, {z, 3}];     r = RandomReal[10, {z}];     obj = GraphicsComplex[p, Sphere[Range[z], r]];     t0 = AbsoluteTime[];     gr = Graphics3D[obj, Axes -> True]      I would be pleased about any suggestions.


Failure to export graphics by right-click when Notebook magnification is changed

When I try to export graphics as PNG, JPG and other rasterized formats using the right-click and choosing `Save Graphic As...`, if the notebook magnification is changed from 100%, Mathematica fails to export the image and returns the following Error: "The specified setting for the option WindowSize cannot be used." However this does not happen when `Export` function is used to export the graphic. ![enter image description here](http://i.stack.imgur.com/C5UjW.png) I think this is a bug. I am using _Mathematica_ v9.0.1 installed on Microsoft Windows 7 (64 Bits). **UPDATE** This bug is still present in version 10.0.0.0.


2D Arrangment/Optimization Problem

Okay, I have a list of angles, call it A. How would I arrange them in a 2D m-by-n grid G such that the distances between each adjacent angle-element (row- and column-wise) is minimized? G has as many elements as A, or more. I get to pick m and n. Duplicating elements from A is allowed, but every element from A must be used at least once. Toy Example 1:               A = {0, 10, 10, 20, 20, 20, 20, 30, 30}      Put them in a 3x3 array:               G = {      {0,  10,  20},      {10. 20,  30},      {20, 30,  20}     }      Toy Example 2 (list of 5 angles, put them in a 3x2 grid, so have to duplicate 1 element):               A = {0, 350, 10, 20, 30}          G = {      {0,   10, 20},      {350,  0, 30}     }      Hopefully that was clear enough? Let me know if it wasn't....


How to use ChoiceDialog or PopupMenu with ClickPane

What I am trying to do is modify the standard `ClickPane` example where a list of points (`pts`) is added to with each click, in the following way: when a click occurs, some sort of choice window appears, and the user then clicks on one of the options. This is added as a third element in each point, so that `pts` becomes a list of `{x,y,text}` triples (and incidentally gets displayed on the graphic using `Text[]`). Here's the starting point that includes the triples               pts = {{0, 0, "No ID"}};          DynamicModule[{},       ClickPane[         Dynamic@Framed@Graphics[           Map[Text[#[[3]], #[[{1, 2}]]] &, pts],           PlotRange -> 1,           Axes -> True],         AppendTo[pts, Append[#, "No ID"]] &]]      The simplest thing I tried is to replace the "No ID" with a Choice Dialog               speciesList = {"No ID", "Oak", "Sycamore", "Plane", "Birch",                    "Ginko", "Ash", "Beech", "Cherry", "Maple"};          pts = {{0, 0, "No ID"}};          DynamicModule[{},       ClickPane[         Dynamic@Framed@Graphics[           {Point[pts[[All, {1, 2}]]]},           PlotRange -> 1,           Axes -> True],         AppendTo[pts, Append[#, ChoiceDialog["Pick one", speciesList]]] &]]      This does cause a choice dialog to pop up, but the dynamic evaluation seems to go into a spin and I have to abort. Any thoughts on what is going wrong would be appreciated. What I would really like to do is have a `PopupMenu` appear right there at the click point (because input dialogs appear floating in the middle of the screen, which can be a long way away), but that seems harder...


Any efficient way to make complete homogeneous symmetric functions in Mathematica?

We do have elementary symmetric functions, `SymmetricPolynomial[k, {x_1, ..., x_n}]` . But I didn't find complete homogeneous symmetric functions. The induction method to compute $h_n$ from $e_i$ and $h_j$ ($j\leq n-1$) is not that efficient. Is there any easier way to do this?


Agglomerate output to Graph

I'm using the HierarchicalClustering package to cluster some data. So let's say I have this:               Needs["HierarchicalClustering`"]          In[21]:= Agglomerate[{1, 1, 2, 10, 4, 8}, Linkage -> "Single"]          Out[21]= Cluster[Cluster[Cluster[Cluster[1, 1, 0, 1, 1], 2, 1, 2, 1], 4, 4, 3, 1],  Cluster[8, 10, 4, 1, 1], 16, 4, 2]      Is there a direct way to go from that output to an undirected graph structure? The HierarchicalClustering package can create graphs as Dendrograms:               DendrogramPlot[{1, 1, 2, 10, 4, 8}, LeafLabels -> (# &),  Linkage -> "Single"]      But I would like to use the graph functions to work with the data. Maybe I'm doing this wrong and I don't even need the HierarchicalClustering to cluster my data. I would appreciate any ideas. Thanx!


Using uniform coloring in MatrixPlot

I have a rectangular matrix, which is `m`-by-10. Each element is either 0 or 1. I would like 0 to correspond to white elements, and 1 to red elements. This works fine if `m = 100` or similar small values:               m = 100;     list = Table[Table[RandomInteger[], {j, 1, 10}], {i, 1, m}];     Tally[Flatten[list]]     MatrixPlot[list, FrameTicks -> None, ImageSize -> {300, 300},       ColorRules -> {0 -> White, 1 -> Red}]      ![MP1](http://i.stack.imgur.com/cohTl.gif) However, if I choose `m = 200`, the coloring becomes strange and no longer only white or red:               m = 200;     list = Table[Table[RandomInteger[], {j, 1, 10}], {i, 1, m}];     Tally[Flatten[list]]     MatrixPlot[list, FrameTicks -> None, ImageSize -> {300, 300},       ColorRules -> {0 -> White, 1 -> Red}]      ![MP2](http://i.stack.imgur.com/Fqtji.gif) Why do I see orange if each element is either 0 or 1? Is there any way I can correct this so that the only colors that appear are white or red? Setting `ColorFunctionScaling -> False` does not seem to correct the problem: ![MP3](http://i.stack.imgur.com/Cnixq.gif)


How to add a barlegend to a listlineplot?

I'm trying to add a color bar legend to a ListLinePlot with multiple lists. With 20+ lists a normal Legend gets long and bulky. Basically, each list line is associated with a different value. I've created a color gradient for the lines using the Hue function but cannot figure out how to get BarLegend to work with ListLinePlot. I've included a sample of the plot I have so far. It would be a much cleaner presentation with a colorbar for the legend. How do I do this, in an elegant way? I'd even settle for a non-elegant method right now. ![example of what I have](http://i.stack.imgur.com/5Nooe.jpg)


Drawing tubes with a While loop

I'm trying to make a plot with many objects in it using a `While` loop. Something like the following:               Graphics3D[       While[ϕforwhile < Pi/3,          {Lighter[Blue, .1],             {Tube[               Table[                 u*{Sin[Pi/2]*Cos[ϕforwhile], Sin[Pi/2]*Sin[ϕforwhile], Cos[Pi/2]},                 {u, 0, 1, 1/10}],               .005]}};         ϕforwhile = ϕforwhile + Pi/12;]]      Does anyone know how to make this work?


How do I pull from a data list for parameter values in a system of ODEs and then solve and plot?

I have a parameter set list and I would like to solve a system of ODEs multiple times using each parameter set in the list. Then I would like each set of solutions to be graphed on the same plot. For example: I have imported this list of parameter sets:               {{ "a", "b", "c", "d"}, {1, 5, 1, 3}, {2, 3, 2, 2}, {3, 3, 3, 1}}      Then I have this system               system={x'[t] == a*x[t] + b*y[t], y'[t] == c*x[t] + d*y[t], x[0] == 10, y[0] == 0};      I would like to substitute each parameter set in for a,b,c,d respectively, then solve using               sol = DSolve[system, {x[t], y[t]}, {t}]       for each parameter set (or NDSolve, ParametricNDSolve if appropriate) Then I would like all sets of solutions to be plotted on the same graph               Plot[{x[t] /. sol, y[t] /. sol}, {t, 0, 7}, PlotRange -> Automatic].      Note, I would like to use this example to understand the process and apply it to a larger system with more parameters and a larger list of sets of parameters.


Image Processing: Using AdjacentBorders with SelectComponents

I've been doing some image processing and have been having trouble with the `AdjacentBorder` command. I've got an image in which I have several elements that are on the borders, and I was able to use `ComponentMeasurements[image,"AdjacentBorders"]` to obtain the list of what borders these elements touch. However, when I go to use `SelectComponents`, I'm unable to select the elements that are just on one border. Is this possible, or can I only select the components that are bordering a certain amount of borders? This is the image I started with this image ![](http://i.imgur.com/AC0bvkG.png) and the code I've used since.               j := Import@"http://i.imgur.com/AC0bvkG.png"     k := Binarize[j, FindThreshold[j]]     l := SelectComponents[k, "FilledCircularity", -7]     m := ImageCrop[l]     ComponentMeasurements[m, "AdjacentBorders"]      > >     {1 -> {Top}, 2 -> {Right}, 3 -> {Left}, 4 -> {Left}, 5 -> {Right}, >      6 -> {Bottom, Right}, 7 -> {Left, Bottom}} >   I used `ComponentMeasurements` to ensure that I did have points on the borders, which I did.


How to combine a plot with an image

I have an external data file data which contains the position of stars of a galaxy simulations and it looks like this               data = Import["NGC_1566.out", "Table"];     L0 = ListPlot[data, Frame -> True, Axes -> False,           PlotStyle -> {Darker[Green], PointSize[0.001]},           PlotRange -> {{-60, 60}, {-60, 60}}, AspectRatio -> 1]      ![enter image description here](http://i.stack.imgur.com/KffdP.jpg) and here is a real image of the NGC 1566 ![enter image description here](http://i.stack.imgur.com/3WFIL.jpg) Now I would like to plot and fit my data on top of the real image. Any suggestions?


How can I regroup elements in a list into a tree based on their values?

I have a list of elements in an outline, here is an example that is only 3 levels deep:               {         {{"1"},"Setup code"},         {{"1","1"},"Local variables"},         {{"1","2"},"Option variables"},         {{"1","3"},"Check for null Input"},         {{"2"},"Argument Logic"},         {{"2","1"},"X Spec"},         {{"2","2"},"One Dimensional Case"},         {{"2","2","1"},"Tick and Label Generation"},         {{"2","2","2"},"plot generation"},         {{"2","2","3"},"bin names generation"},         {{"2","2","4"},"bar chart generation"},         {{"2","3"},"Y Spec"}     }      And I'd like to transform it into a list of trees of the form {parentNode, {childNode1, childNode2, ...}}, and the nodes themselves are are like {{"1","2",...}, "label"}. For example, the above would become:               answer = {     {         {{"1"},"Setup code"},         {             {{"1","1"},"Local variables"},             {{"1","2"},"Option variables"},             {{"1","3"},"Check for null Input"}         }     },          {         {{"2"},"Argument Logic"},         {             {{"2","1"},"X Spec"},             {                  {{"2","2"},"One Dimensional Case"},                  {                       {{"2","2","1"},"Tick and Label Generation"},                       {{"2","2","2"},"plot generation"},                       {{"2","2","3"},"bin names generation"},                       {{"2","2","4"},"bar chart generation"}                  }             },             {{"2","3"},"Y Spec"}         }     }          }      The reason being that once it is in this form, OpenerView[] could be used to make an interactive collapsable outline, for instance:               ToOutline[l_List] :=        Panel @ Grid[          Partition[           Panel /@ ToOutline1 /@ l //. {x_, list_List} :>              ToOutline1[{x, list}], 4, 4, 1, {}],           Alignment -> Top] /. {n : {__String}, s_String} :>          Row[{StringJoin @ Riffle[n, "."] , "  ", s}];     ToOutline1[{x_, list_List}] :=       OpenerView[{x, Column[Panel /@ list]}, True]     ToOutline[answer]      generates ![enter image description here](http://i.stack.imgur.com/XYhLQ.png) ## Motivation This questions helps solve the problem of extracting comments from a file in Wolfram Workbench of the form `(* tag:1:2:2:3... text... *)`. So for example if I had commented my function MyFun with a comment like `(* MyFun:1:... text... *)`, I could extract them as follows:               CommentsToOutlineElements[filePath_, ID_] := Module[{allComments, commentsIDs, IDs, commentsStrings},         allComments = Cases[Import[filePath, "Comments"], _?(!StringFreeQ[#, ID]&)]         commentsIDs = StringSplit[#1, Whitespace][[1]]& /@ allComments;         commentsStrings = StringCases[#1, Shortest[s__]~~Whitespace~~Longest[c__] :> c][[1]]& /@ allComments;         IDs = Rest[StringSplit[#,":"]]& /@ commentsIDs;         Transpose @ {IDs, commentsStrings}     ]     CommentsToOutlineElements["User/...", "MyFun"]      And then generate a nice outline of the function, as per this question.


Using Refresh to skip expensive computations

I have several variables in my `DynamicModule` and some parts of my computation depend only on subset of them. I am trying to use Refresh to "cache" values but can't make it work. Example of the problem:               verySlowFunction[x_] := Module[{}, Print["SLOW"]; x * x];          DynamicModule[      {a = 1, b = 1},      Dynamic[       Module[        { x = Refresh[verySlowFunction[a], TrackedSymbols :> {a}] },        Column[{          Slider[Dynamic[a]],          Slider[Dynamic[b]],          {a, b , x + x + b}           }]]]]      I expect "SLOW" to be printed only when I drag "a" slider, but it is printed when I'm dragging "b" slider as well. I know that Dynamic clones whole expression tree on its evaluation, that's why `x` is always different, but this one doesn't work as well:               Module[      {x},      DynamicModule[       {a = 1, b = 1},       Dynamic[         x = Refresh[verySlowFunction[a], TrackedSymbols :> {a}] ;        Column[{          Slider[Dynamic[a]],          Slider[Dynamic[b]],          {a, b , x + x + b}           }]]]]


How could I obtain real numbers for the following integration instead of imaginary ones?

As shown in the following codes,               lamda1 = 1.875; L = 0.2; bL = 0.015; hL = 0.005; rouL = 2550; mL = rouL*bL*hL*L; roL =     mL/L; gama1 = (Cosh[lamda1] + Cos[lamda1])/(Sinh[lamda1] + Sin[lamda1]);      phi1 = Cosh[lamda1*(x/L)] - Cos[lamda1*(x/L)] - gama1*(Sinh[lamda1*(x/L)] - Sin[lamda1*     (x/L)]);      fe1 = Cosh[lamda1*(sigmma/L)] - Cos[lamda1*(sigmma/L)] - gama1*(Sinh[lamda1*(sigmma/L)] -     Sin[lamda1*(sigmma/L)]); z1 = D[fe1, sigmma]; z21 = z1^2;      fec1 = -0.5*Integrate[z21, {sigmma, 0, x}]; ux = fec1*q4[t]^2; uy = phi1*q4[t]; uf =      {{ux}, {uy}}; AL = {{Cos[q3[t]], -Sin[q3[t]]}, {Sin[q3[t]], Cos[q3[t]]}}; r0 = {{q1[t]},     {q2[t]}};      u0 = {{x}, {0}}; RL = r0 + AL . (u0 + uf); REy = Take[RL /. x -> L, -1]; vRL = D[RL, t];     Print["vRL=", MatrixForm[vRL]]; intTL = ExpandAll[Transpose[vRL] . vRL]; Print["intTL=",     intTL];      FullSimplify[Re[Integrate[intTL, {x, 0, L}]], Assumptions -> Element[{q1[t], q2[t],      q3[t], q4[t], Derivative[1][q1][t], Derivative[1][q2][t], Derivative[1][q3][t],          Derivative[1][q4][t]}, Reals]]      How could I get real numbers instead of imaginary ones?


Edge finite elements in Mathematica

I am wondering if it's possible to extend the Finite Element capabilities of Mathematica so as to include other types of elements such as edge vector elements (Nedelec) which can be used in electromagnetic problems. If possible, how would one proceed?


Solving a differential Equation

I am trying to solve               -D[((α + γ/2)*a + β/(2*a) - R*a^3)*p[a], a] + 0.5*D[(γ*a^2 + β)*p[a], {a, 2}] == 0      with `DSolve`, but it does not work. If I let `R = 0`, then I am able to obtain an explicit solution for `p[a]`.               DSolve[         -(-3 a^2 R + α - β/(2 a^2) + γ/2) p[a] -          (-a^3 R + β/(2 a) + a (α + γ/2)) Derivative[1][p][a] +          0.5 (2 γ p[a] + 4 a γ Derivative[1][p][a] + (β + a^2 γ) (p^′′)[a]) == 0,        p[a], a]      Can someone kindly help me on this.


Prevent graphics render inside held expression

Assuming each odd line is input I would like the even lines to be the output of the following lines. ![enter image description here](http://i.stack.imgur.com/WZx4t.png) In the above the `Graphics` are inside `Hold`/`HoldForm` therefore IMO it doesn't make sense to have Mathematica try and render such expressions. For example `Hold[Graphics[{Red, Circle[]}]]` throws an error because built in colors don't get replaced. How might I prevent `Graphics` from being rendered and instead print the Graphics code? The following code works at reassigning Graphics inside Hold/HoldForm, but it prints something like `Graphics[{Circle[{0, 0}]}]` without the `HoldForm`/`Hold`.               Unprotect[Graphics]     Graphics /: HoldForm[Graphics[x___]] := (        InputForm[Graphics[x]]        );     Graphics /: Hold[Graphics[x___]] := (        InputForm[Graphics[x]]        );      Ideally the code should be generalize to work with irregular constructs like `HoldForm["a",Graphics[{Circle[{0, 0}]}]]`. More importantly how might you insure `HoldComplete` doesn't render Graphics either. As rm-rf pointed out the Villegas–Gayley trick will likely be needed. * * * Simplifying John Fultz's answer slightly, you get the following:               Map[      (        Unprotect[#];        # /: MakeBoxes[#[expr_], fmt : StandardForm | TraditionalForm] :=          Block[{Graphics, Graphics3D},          RowBox[{ToString[#], "[", MakeBoxes[expr, fmt], "]"}]          ];        Protect[#]        ) &, {Hold, HoldForm, HoldComplete}      ]


Mathematica outliner's capabilities

As my notebooks get larger, I often try to organize them with titles/subtitles etc, structuring them as an outliner (http://en.wikipedia.org/wiki/Outliner) This also helps me as I try to structure a notebook trying to produce an article, see http://reference.wolfram.com/mathematica/tutorial/NotebooksAsDocuments.html Unfortunately, I find that Mathematica's outliner capabilities are not so developed... a major source of irritation is that the markers indicating closed groups are very hard to see, and so small I often click on the wrong bracket level trying to open/close them. For me the ideal way would be a doubleclick on the block header to open/close it. Also, it is not easy at all to take a block and shift it upper or lower in a hierarchy of levels. Do you know if there is a way to enhance M's capabilities in this field? Maybe through some specialized stylesheet? (edit ------) I see by the help you are kindly offering that there is indeed some way to enhance the outliner capabilities - so to rise the bar a bit, knowing that this is a typical outliner feature: do you know a way to ask your notebook to "show everything down to level x" - that is e.g. keep anything under the level Subsection (or Subsubsection, or ...) closed?


Rough mesh lines in partially opaque 3D plots

If I plot a surface with mesh lines, they show up fine (of course). However, if the surface is even just a little transparent, they get quite rough. Compare this to setting the Opacity to 1:                 ParametricPlot3D[{4 + (3 + Cos[v]) Sin[u], 4 + (3 + Cos[v]) Cos[u],         4 + Sin[v]}, {u, 0, 2 Pi}, {v, 0, 2 Pi},         PlotStyle -> Opacity[.99],        MeshStyle -> Thickness[.005],         ImageSize -> 800,        Axes -> False, Boxed -> False]      Here are the results: ![rough lines](http://i.stack.imgur.com/z9Fbo.jpg) ![smooth lines](http://i.stack.imgur.com/hfenx.jpg) How can I get proper smooth lines and use Opacity at the same time? UPDATE (Aug. 9, 2014): Wolfram tells me that "this is an issue with rendering transparent 3D objects on Linux systems using Intel graphics hardware." It has to do with "depth peeling".


Why setting PlotPoints make my 3d contour plot broken?

I'm trying to make a iso surface plot from some data using ContourPlot3d. My data is a 3 dimension data with form like `{{x,y,f[x,y]},...}`. I first make this data into 4d by rotating it along the x axis, so that `{x,y,f[x,y]}` becomes `{x,y,z,f[x,y,z]}`. Then interpolate them and plot the interpolated function. But sometimes I get a broken surface. Here is the detail:               Get["https://dl.dropboxusercontent.com/u/24667921/data.dat"];     f = Interpolation[data];     f3d[x_, y_, z_] := f[x, Sqrt[y^2 + z^2]];          ContourPlot3D[      Abs[f3d[x, y, z]]^2, {x, -15, 15}, {y, -15, 15}, {z, -15, 15},       Mesh -> None, PlotPoints -> 20, Contours -> {1*^-6},       ViewPoint -> {1.3, -1.3, 2.9}, ViewVertical -> {0.2, -1, 0.2},       Axes -> False, Boxed -> False, ImageSize -> 300]      ![enter image description here](http://i.stack.imgur.com/AwyGu.png) We can see two dark spot on the surface. If I remove the `PlotPoints->20`, the holes are gone. And this seems not caused by the same reason from this post, because I still see the broken surface as I exported to pov file and rendered in povray. For my problem I can't just remove the `PlotPoints->20` option, because I have to generate the same kind of plots from a serial of data. And I have to set a PlotPoints to a number to make sure the contour can be found. ![enter image description here](http://i.stack.imgur.com/0yG0r.png)


How to compute this triple integral?

In **Mathematica** how can I compute this integral:$$ \iiint_{D}\sqrt{(1-9z^2)(1-4y^2-9z^2)}\,dx\,dy\,dz$$ where D is the domain: $$D: x^2 +4y^2+9z^2\le1$$ Please I need help!!!


How do I get a list of allowed values for an option?

When using _Mathematica_ how can I get a list of the allowed values of an option? As an example I can use the `Options` command as follows -               Options[Manipulate]      which gives me a list of available options               (* {Alignment->Automatic,AppearanceElements->Automatic,AutoAction->\     False,AutorunSequencing->Automatic,BaselinePosition->Automatic,\     BaseStyle->{},Bookmarks->{},ContentSize->Automatic,ContinuousAction->\     Automatic,ControlAlignment->Automatic,ControllerLinking->Automatic,\     ControllerMethod->Automatic,ControllerPath->Automatic,\     ControlPlacement->Automatic,ControlType->Automatic,DefaultBaseStyle->\     "Manipulate",DefaultLabelStyle->"ManipulateLabel",Deinitialization:>\     None,Deployed->False,Evaluator->Automatic,Frame->False,FrameLabel->\     None,FrameMargins->Automatic,ImageMargins->0,Initialization:>None,\     InterpolationOrder->Automatic,LabelStyle->{},LocalizeVariables->True,\     Method->{},Paneled->True,PreserveImageOptions->True,RotateLabel->\     False,SaveDefinitions->False,ShrinkingDelay->0,\     SynchronousInitialization->True,SynchronousUpdating->Automatic,\     TouchscreenAutoZoom->False,TouchscreenControlPlacement->Automatic,\     TrackedSymbols->Full,UnsavedVariables:>None,UntrackedVariables:>None} \     *)      I can use `Options` for a specific parameter, i.e.,               Options[Manipulate,ControlType]     (* {ControlType->Automatic} *)      But this doesn't tell me what the possible allowed values are for this option. Checkbox, Setter etc. Is there a command I can use to find the allowed values of an option?


GraphPath: *all* shortest paths for 2 vertices, edge lengths negative

_Mathematica_ uses Bellman-Ford to find a shortest path between two vertices when the edge lengths are negative:               g = SparseArray[{{1,2} -> -1,{1,3} -> -1,{2,4} -> -1,{3,4} -> -1}]       GraphPath[g,1,4]      yields > {1,2,4} I want to find _all_ such shortest paths. In the example above, `{1,3,4}` is another shortest path. Goal: I'm testing a non- _Mathematica_ shortest path algorithm against _Mathematica_. My algorithm also lazily finds only one shortest path, but it's different from the path _Mathematica_ finds. I need to confirm my algorithm's shortest path really is a shortest path. I realize I could just compare the path lengths (if they're equal, my algorithm has found a shortest path), but that wouldn't catch other errors in the algorithm (eg, if it's inventing edges or nodes or something). I also realize I could have _Mathematica_ find all paths or something and filter for the shortest ones, but that seems inefficient for larger graphs. I've read Finding all shortest paths between two vertices, but   1. I couldn't get it to work with _Mathematica_ 9, and, more importantly   2. it appears to be for positive-length edges.  NOTE: I realize I'm using a SparseArray for a graph above, but _Mathematica_ seems to be OK with this.


calling CUDA library functions

Mathematica has some predefined CUDA functions, like CUDAMap, CUDAFourier, etc. My question is how can one call functions which are part of CUDA library but not part of predefined Mathematica functions? For example, CUDA 6.0 has a large Math library; so if I am to call cuFFT from that library instead of using CUDAFourier, how would I go about doing this? Do I have to write a C code which calls the cuda library function and then call the c function from Mathematica. That seems too round about way of doing something. I could not quite find it in the documentation. Thanks very much!


Compute (Co)Variance of Random Variable(s) Directly

Is there a direct command in Mathematica that computes the covariance between two random variables? Hence, instead of typing               Expectation[f(x)*g(y),{y~some distribution,x~some distribution}] -      Expectation[f(x),{y~some distribution,x~some distribution}]*     Expectation[g(y),{y~some distribution,x~some distribution}]      Is there a command that archieves the same by typing simply               Covariance[{f(x),g(y)},{y~some distribution,x~some distribution}]      I have tried to use the following function:               CoVar[RVfuncs_, dist_] :=      Expectation[RVfuncs[[1]]*RVfuncs[[2]],      dist] - (Expectation[RVfuncs[[1]], dist]*Expectation[RVfuncs[[2]], dist])      It works, but it is much slower than writing out the three "Expectation" parts.


Shading between polar graphs

Since `PolarPlot` doesn't support `Filling`, what is the best way to shade or fill the a region between two polar curves? For instance, how would I generate a version of the following graph with the region inside the first curve but outside the second curve filled?               PolarPlot[{{1, -1} Sqrt[2 Cos[t]], 2 (1 - Cos[t])}, {t, -\[Pi], \[Pi]}]      ![Mathematica graphics](http://i.stack.imgur.com/C7rJB.png)


EventHandler {"MouseDown", 1} with PassEventsDown -> True not working as expected

I want my `EventHandler` to respond only to left mouse clicks and pass the right mouse click to the built in event handler. I have tried               DynamicModule[{pt = {0, 0}},       EventHandler[       Graphics[{Disk[Dynamic[pt], .1]},         PlotRange -> 1], {"MouseDown", 1} :> (pt = MousePosition["Graphics"]), PassEventsDown -> True]]      But the problem is that the point moves even on right clicks. Is this a bug? **How can I make the point move only on left clicks and display the graphics pop up menu on right clicks (without moving)?**               DynamicModule[{pt = {0, 0}},       EventHandler[       Graphics[{Disk[Dynamic[pt], .1]},         PlotRange -> 1], {"MouseDown", 1} :> (pt = MousePosition["Graphics"]), PassEventsDown -> False]]      Responds only to left clicks as expected. So to clarify: I want to have this menu, but without the point going to the position of the right click. The point should respond to left clicks only. ![Mathematica graphics](http://i.stack.imgur.com/mBqGq.png) I'm running MMA 9.0.0 on Win 7 64 bit.


NDSolve much slower when using InterpolatingFunctions inside

I am solving an ODE system with _Mathematica_. Let's say the system is of the form (to simplify).               sol = NDSolve[{x'[t] == f[t] x[t] + g[t], x[0] == 0}, x, {t, 0, 1}]      The functions `f[t]` and `g[t]` are obtained from a different program. I either use a simple fit for `f[t]` and `g[t]` (say polynomial) or define them as `InterpolationFunctions` from data tables I have, i.e.               f = Interpolation[data]      In the latter case (which is more desirable as more accurate), the system takes 10 times longer to solve! In detail, I actually loop over `NDSolve` for several additional parameters, and my ODE is with complex coefficients and 6-dimensional. So the system is already kind of long to solve, and 10 times longer is killing me... Anyone has any advice on how to speed this up? Interpolating functions should be super fast, shouldn't they?


Integrating hat functions

I am trying to integrate a hat function for a project that I am doing and have found a method to do so but I find it sloppy. Currently I have the basis function               \[Psi][z_] := z - Subscript[Z, i]/ \[CapitalDelta]z + 1;      which I am trying to integrate from $z_{i-1}$ to $z_{i+1}$. I break the basis function up into two pieces and integrate the left side from $z_{i-1}$ to $z_{i}$ and then the right side from $z_i$ to $z_{i+1}$. My first question is, is there a way to integrate piecewise functions? The second question I have is, is there a way to set global assumptions like $z_{i-1} < z_i < z_{i+1}$, $z_i - z_{i-1} = \Delta z$ , etc? **Edit** : This is the piece wise function taken directly from my code I am trying to integrate               \[Psi][z_, c_] :=  Piecewise[{{(z - c)/\[CapitalDelta]z + 1,       z <= c}, {-(z - c)/\[CapitalDelta]z + 1, z > c}}];      where $c$ is the center of the hat function. Here is my attempt to integrate the piece wise function                FullSimplify[      Integrate[\[Psi][z, Subscript[Z, i]], {z, Subscript[Z, i - 1],         Subscript[Z, i + 1]}],       Assumptions -> {-(Subscript[Z, i + 1] - Subscript[Z,             i ]) == -\[CapitalDelta]z,         Subscript[Z, i + 1] - Subscript[Z,           i ] == \[CapitalDelta]z, -(Subscript[Z, i] - Subscript[Z,             i - 1 ]) == -\[CapitalDelta]z,         Subscript[Z, i] - Subscript[Z, i - 1 ] == \[CapitalDelta]z}]      I do not get a usable answer. Am I doing something wrong (ie can one integrate a piece wise function)?


How to play microtonal music using Mathematica?

I am trying to model microtonal music using `Play`. I have only partial success because it takes such a long time to make some sound. Could you please have a look at my stackoverflow.com question? The link is http://stackoverflow.com/questions/14849184/how-to-play-microtonal-music- using-mathematica-or-other-tools **=========== Original question linked above ===============** Do you have any suggestions how to write and play microtonal music? My solution: I tried to use `Play` and `Piecewise` but it takes a LONG time to take a sound! Please read the details. As you know there are many notes other than Do or Re or Mi of western music. So maybe I can not use `SoundNote` for ancient music. Each note is represented as a fraction. Using middle Do as a base (i.e., `base = 260.741 Hz`); the next notes are represented by `re = 9/8 base`, `mi = 5/4 base`, `fa = 4/3 base`, `di = 3/2 base`, etc. For example, to play fa for 2 seconds with `SoundVolume = 1/3`, evaluate               Play[1/3 Sin[ fa 2 Pi x], {x,0,2}].      I model each such instance with a list of the form `{time, note, soundvolume}`, for example `{2, fa, 1/3}`. Consider a very short example of such a sequence of notes               voice1= {{1, 9/8, 1}, {1, 5/4, 2/3}, {1/2, 4/3, 1/3}, {1/2, 9/8, 1/3}, {1, 4/3, 1},              {1, 3/2, 2/3}, {1, 4/3, 1/3}}      How can voice1 be easily played using `Play`? I tried using `Piecewise`, but with that I have to wait for a LONG TIME before I get any sound result. (Maybe the reason is the use `Piecewise` in `Play`, but I am not sure.) Please, try the following example to see how slow you get the sound result for voice1.               Play[       Piecewise[{         {1, 0. < x <= 1},         {2/3, 1 < x <= 2},         {1/3, 2 < x <= 5/2 || 5/2 < x <= 3},         {1, 3 < x <= 4},         {2/3, 4 < x <= 5},         {1/3, 5 < x <= 6},         {0, True}}]       Sin[ base 2 Pi          Piecewise[{           {9/8, 0. < x <= 1},           {5/4, 1 < x <= 2},           {4/3, 2 < x <= 5/2},           {9/8, 5/2 < x <= 3},           {4/3, 3 < x <= 4},           {3/2, 4 < x <= 5},           {4/3, 5 < x <= 6},           {0, True}           }]],       {x,0, 6}]


Write a table to a file

I want to compute a multidimensional table in Mathematica and write it to an external file. Here is a simple example. I have three lists `x`, `y`, `z` and the output include all possible combinations of sums. In the output file, I want 27 = 3x3x3 rows. Each row should have four values: `x`, `y`, `z` and `x+y+z`. Here is my code.               x = {1, 2, 3};     y = {4, 5, 6};     z = {7, 8, 9};     output = Table[x[[i]] + y[[j]] + z[[k]], {i, 1, 3}, {j, 1, 3}, {k, 1, 3}]     sfile = OpenWrite["C:\\Temp\\test.txt"]     For[i = 1, i <= 3, i++,      {For[j = 1, j <= 3, j++,        {For[k = 1, k <= 3, k++,          Write[sfile, x[[i]], y[[j]], z[[k]], output[[i, j, k]]]]}]}]     Close[sfile]      The problem is there is no space in the output file. So I get something like               14712     14813     14914     15713     15814      but I actually want               1 4 7 12     1 4 8 13     1 4 9 14     1 5 7 13     1 5 8 14      I need help to get the format above. I am quite new to Mathematica and don't know much about other functions. I am OK with any functions as long as they can generate the output I want. Thank you.


Generating a Sierpinski carpet

I am trying to draw a Sierpinski_carpet. I have code that works, but I think there is a more elegant way to do than my way. Maybe I couls use `Tuples` or `Permutations` or some similar function to simplify my code. ![enter image description here](http://i.stack.imgur.com/x3FRh.png)               f[{{x1_, y1_}, {x2_, y2_}}] := Map[Mean, {         {{{x1, x1, x1}, {y1, y1, y1}}, {{x1, x1, x2}, {y1, y1, y2}}},         {{{x1, x1, x1}, {y1, y1, y2}}, {{x1, x1, x2}, {y1, y2, y2}}},         {{{x1, x1, x1}, {y1, y2, y2}}, {{x1, x1, x2}, {y2, y2, y2}}},         {{{x1, x1, x2}, {y1, y1, y1}}, {{x1, x2, x2}, {y1, y1, y2}}},         {{{x1, x1, x2}, {y1, y2, y2}}, {{x1, x2, x2}, {y2, y2, y2}}},         {{{x1, x2, x2}, {y1, y1, y1}}, {{x2, x2, x2}, {y1, y1, y2}}},         {{{x1, x2, x2}, {y1, y1, y2}}, {{x2, x2, x2}, {y1, y2, y2}}},         {{{x1, x2, x2}, {y1, y2, y2}}, {{x2, x2, x2}, {y2, y2, y2}}}         }, {3}];     d = Nest[Join @@ f /@ # &, {{{0., 0.}, {1, 1}}}, 3];     Graphics[Rectangle @@@ d]     Clear["`*"]


Identifying the color in Image

This has mad me Crazy for a while Can any one please Help me solving this this is the Image that I am working on . Basically this image is made up of 98 different color patches 7 patch on each level and there are 14 such level I want to get the colour of each patch on each level in something like an array   like this                 colorPatch={{#524,#521,#124,#897,#365,#489,#546},   -->Level 1                 {#124,#524,#897,#365,#546,#514,#687},   -->Level2                 .                 .}                                   -->nth Level this is what i did till now               s = Import["http://i.stack.imgur.com/ubuPp.jpg"];     p = ImagePartition[s, {50, 69}]      ![enter image description here](http://i.stack.imgur.com/ubuPp.jpg)


Finding the minimum of a function

I asked this question Mark Minimum Value in DensityPlot. Another question has come up, or better said, a task: Find the minimum of a function. I haven't been able to write the needed code for that, because I want to find the minimum of the function `ueislexpl[epsilon, h, n1, n2]` with respect to `n1` and `n2`. But `ueislexpl` calls the function `eislminx2[epsilon_?NumericQ, n2_?NumericQ]`, which needs a value for `n2`. For tests one may use `epsilon = 0.1`. Is there a way of finding the minimum of `ueislexpl[epsilon, h, n1, n2]` with respect to `n1` and `n2`?               eislexpl[gamma_,epsilon_, n2_, x_] :=         28 (epsilon)^2 - 1 + ((-2 Log[E^(1/2) x])/x^2 + (27/10(gamma - epsilon))/x +          (10 epsilon^2 n2^(3/2))/x^(3/2))          eislminx2[gamma_,epsilon_?NumericQ, n2_?NumericQ] :=      (       minx = FindArgMin[{eislexpl[gamma,epsilon, n2, x], 0 < x}, x];       eislexpl[gamma,epsilon, n2, minx]     )          ueislexpl[gamma_,epsilon_, h_, n1_, n2_] :=        n1 (40  epsilon^2 - 1) + (1 -127/100 ) (1 + (n1 - 1) HeavisideTheta[1 - n1] -        (-1 + Exp[-(n1 - 1)]) HeavisideTheta[n1 - 1]) + n2  eislminx2[gamma,epsilon, n2] +        (h - n1 - n2) (28  epsilon^2 - 1)      The function `ueislexpl[gamma,epsilon, h, n1, n2]` describes the energy of a specific type of crystal morphology. It is used to predict specific growth modes. `h` is the total amount of deposited material `h=n1 + n2 + n3`. There are 3 different types of structures that can appear. A so called wetting layer, 3d-structures of kind 1 (3ds1) and 3d-structures of kind 2 (3ds2). `n1`is the amount of material comprising the wetting layer, `n2`is the amount of material comprising 3ds1, and whats left of `h`, `h-n1-n2=n3` is the material comprising 3ds2. In my simulations i usually use values of h within [0,8], meaning that values for n1 and n2 are too within [0,8]. I saw, that i oversimplified my functions, so i edited them, now there is one variable more, `gamma`, the surface energy per unit area, epsilon is the strain. My goal is to plot 2 different phase diagrams, one that shows the energy as a function of `h` and `epsilon` and the second one showing the energy as a function of `h`and `gamma`. The function `eislminx2[gamma,epsilon, n2]` determines the energetic minimum for a given set of `gamma`,`epsilon` and `n2` \- so i can't give constant values for them, they need to be variables. And the function that determines the energetic minimum of the system (minimum of ueislexpl[gamma,epsilon, h, n1, n2]) needs to be able to deal with that, is that possible? Determining the formal minimum of ueislexpl[gamma,epsilon, h, n1, n2], leaving some variables blank for the moment, as if i took the derivative of `y=a x^2 + x`, `dy/dx=2 a x + 1=0` \- even though i dont know the value of a i can formally take the derivative and later on plug in values for a and determine the minimum. Or is there another way?


grid lines in Manipulate plots are not showing up when first rendered?

I have a `Manipulate` within which the plot does not render completely initially:               Manipulate[      tick;      If [ bRefreshPlot, (          plot = ParametricPlot3D[ {u, v, u^2 + av (-1)^fn v^2}, {u, -1, 1}, {v, -1, 1} ] ;        bRefreshPlot = False )       , ] ;      plot      , Grid[{        { Slider[ Dynamic[av, ( av = # ; bRefreshPlot = True ; tick = Not[tick]) &] , {0.05, 2} ], Dynamic@av },        { SetterBar[Dynamic[fn, ( fn = # ; bRefreshPlot = True ; tick = Not[tick]) &] , Range[2] ] }      }]      , {{tick, False}, None}      , {{av, 1}, None}      , {{bRefreshPlot, True}, None}      , {plot, None}      , {{fn, 2}, None}      , TrackedSymbols :> {tick}      , ControlPlacement -> Left      ]      Initially, the `Manipulate` output looks like: ![initially](http://i.stack.imgur.com/j6Brq.png) but after clicking each of the `SetterBar` buttons in sequence (toggling from paraboloid to saddle and back), the grid lines then show up as in: ![with grid lines](http://i.stack.imgur.com/W22p5.png) I appear to be able to use '`SaveDefinitions` -> True' to work around the initial display oddity. However, this lack of grid lines also occurs after adjusting the slider. After an adjustment of the slider, the plot is first rendered without grid lines, but after doing the same two-click toggle of the `SetterBar` buttons, the plot shows up properly with the grid lines?


Removing outermost braces

I want to calculate the Kronecker product of several matrices in different orders. the number of these matrices must be changeable.               sysdim = 5;(* number of matrices I want to multiply. this number must be changeable*)          id = IdentityMatrix[sysdim];          sp = (* it's a matrix. It can be anything. It's size is sysdim by sysdim*)          Do[Subscript[variable, i] = ReplacePart[KroneckerProduct[id, id, id, id, id], {i ->     sp}], {i, 1, sysdim}]      By this I can get all different Kronecker products corresponding to different orderings. However, I want to change the number of these matrices as I wish. So, I thought the solution could be something like this:               KroneckerProduct[Table[id,{i,1,sysdim}]]      The problem here is that the `Table`command returns:               {id, id, id, id, id}      which `KroneckerProduct`is not happy with. I need to get rid of the outermost braces to get the `KroneckerProduct`to work.


Removing sublists containing elements from another list's sublist

Let there be two lists that have sublists:               a[] = {{1, 2}, {1, 2, 3}, {2, 3, 4, 4}, {3, 4, 4, 5}}      and               b[] = { {1, 2}, {4, 5, 6}}      I want to remove all those sublists in a[] that has elements contained in a sublist of b[]. So after removal I am expecting               a[] = {{2, 3, 4, 4}, {3, 4, 4, 5}}.      I am not able to reach specific elements in a sublist. I can use a For loop for this, but it will slow down my program, so I want suggestions on a better _Mathematica_ way of manipulating lists. ### Edit Sorry I guess my example was less than clear about what I am asking for. I want that any sublist in `a[]` that has all elements of any sublist from `b[]` shall be removed.


How can I get precisely the subgraph corresponding to a set of edges?

Consider the complete graph on 3 vertices. ![enter image description here](http://i.stack.imgur.com/DB15Z.png) Then, a method gives me a list of interesting edges, say $\\{(1,2),(2,3)\\}$. I want to get a subgraph of $g$ that corresponds to precisely the given edgelist. How can I do this? If I use `Subgraph[g,e]` with `e = {1 \[UndirectedEdge] 2, 2 \[UndirectedEdge] 3}`, I get back the original graph. This does preserve the colors, but includes an extra edge, namely $(3,1)$ that I don't want. However, `Subgraph` does have a pattern as an argument. That might do the trick, but perhaps there's an easier way.


Showing special characters in text containing unicode

How does one conveniently convert a string like: "Ya no me burlar\:00e9 de la diabetes de Nick Jonas. Me lo guardar\:00e9 para cuando le corten la pierna. S\:00ed es que a\:00fan alguien lo recuerda, claro." to "Ya no me burlaré de la diabetes de Nick Jonas. Me lo guardaré para cuando le corten la pierna. Sí es que aún alguien lo recuerda, claro."? Certainly if I directly input the former, Mathematica autoformats it to the latter. If that text, however, comes to me whole from an outside source it is not automatically reformatted to show the special character. There is the ShowSpecialCharacters option in TextCell, for example, but that doesn't preserve the object as a String. I intend to parse a lot of text and would ideally prefer to avoid applying a function that first finds all substrings "\:", then converts to CharacterCode, then StringReplace's, etc.


How can I preserve the properties of edges of the original graph $g$ in a subgraph that doesn't include every edge of $g$?

_The closest question to the following I could find wasPreserving labels when using graph functions, but it doesn't seem to cover this._ Consider a graph `g` where every edge is associated with an EdgeStyle.               g = CompleteGraph[3, VertexLabels -> "Name", ImagePadding -> 10];     PropertyValue[{g, 1 \[UndirectedEdge] 2}, EdgeStyle] = Red;     PropertyValue[{g, 1 \[UndirectedEdge] 3}, EdgeStyle] = Green;     PropertyValue[{g, 2 \[UndirectedEdge] 3}, EdgeStyle] = Blue;      ![enter image description here](http://i.stack.imgur.com/SkPTD.png) I have a method that returns interesting subgraphs of `g`. Suppose $\\{ (1,2),(2,3) \\}$ is one such subgraph. How can I create a subgraph that preserves the colors associated with the edges? I can do               Graph[EdgeList[g], Options[g]]      which gives me the original graph, with the colors preserved. I can also simply do               Graph[EdgeList[g], Options[g, {EdgeStyle}]]      which also works as expected. However, this seems to be so because there's an EdgeStyle for precisely every edge in the options. If there is even one edge in options that is not included in the graph, this won't work. (By _not working_ , I mean something like "the command is not recognized". I don't exactly know how to describe what happens since I'm new to Mathematica.) An example of this unwanted behaviour is ![enter image description here](http://i.stack.imgur.com/dRmLn.png) Is there a way I can tell Mathematica "give me the options of the original graph, but only include a setting for each edge that is present in the new graph"? I really only care about EdgeStyle.


ctags for Mathematica files?

I alway use vi to edit Fortran files. I can use ctags to know which variables and functions I have already defined. Now I use vi to edit Mathematica *.m files. I tried to use ctags for *.m files, but it does not work. I have searched for the solution in Google but no luck. Could you give me some suggestions?


Aborts and beeps without error warning

I have a piece of code that generates a figure, performing a calculation to generate each pixel. At a certain resolution it runs fine, but after a high enough resolution it fails. Mathematica beeps (sounds more line a 'dong') and just stops after a few seconds with no error warnings. How can I run some diagnostics on my code to try and figure out the problem? I assume it's a memory problem, but when I use the MaxMemoryUsed[] command it was only ~20Mb which doesn't seem that much. The code is shown below. I adjust the parameter 'res'. Up to res=12 it runs fine but thereafter it fails.               Clear["Global`*"];     startTime = AbsoluteTime[];     f[{rx_, ry_}] :=       Module[{e1, e2, e3, d1, d2, d3, a, b, c, sol1, sol2, data, round,         rArray},       {e1, e2, e3} = # & /@ {{0, -1}, {Sqrt[3]/2, 1/2}, {-Sqrt[3]/2, 1/2}};       If[        Norm[{rx, ry} - e1] <= 1/3 || Norm[{rx, ry} - e2] <= 1/3 ||          Norm[{rx, ry} - e3] <= 1/3,        Null,        {d1, d2, d3} = # - {rx, ry} & /@ {e1, e2, e3};        {a, b, c} = Norm[#]^-3 & /@ {d1, d2, d3};        round = 0.000001;        sol1 =         If[0 <= ((b + c)^2 - a^2)/(4 b c) <= 1, 0,          Re[{x, y} /. Solve[             Round[a b (d2 - d1), round] Sin[{x, y}.(d1 - d2)]               + Round[b c (d3 - d2), round] Sin[{x, y}.(d2 - d3)]               + Round[a c (d3 - d1), round] Sin[{x, y}.(d1 - d3)]              == 0, {x, y}]]];        sol2 =          Sqrt[a^2 + b^2 + c^2 + 2 a b Cos[#.(d1 - d2)] +              2 b c Cos[#.(d2 - d3)] + 2 a c Cos[#.(d1 - d3)]] & /@ sol1;        Min[sol2]        ]       ]     res = 20;     rArray = Table[{rx, ry}, {rx, -Sqrt[3]/2, Sqrt[3]/2,          Sqrt[3]/res}, {ry, 3/4, -3/4, -3/(2 res)}];     diagram = Map[f, rArray, {2}];     ArrayPlot[diagram, ColorFunction -> "Rainbow",       ColorRules -> {0 -> White, Null -> Gray}]     endTime = AbsoluteTime[] - startTime


Finding elements from a sparse matrix

I am dealing sparse matrices of very large dimensions. I need to locate the positive and negative elements of the matrices and make lists of their corresponding positions. Of course I can write a program which scans every element and gives the output. But is it possible to do it in a neater way? for instance, to make a list of `1`'s, I used `Position[S,1]`, but in future I need to get a list of positions of all entries which are `>0` for example. As suggested, I am giving an example of one of the smallest lists. For instance, I want to make a list of positions of elements which are `>0`.               S={{1,0,0,0,1,0,0,0,0,-1,0,0,0,-1,0,0,0,-1,0,0,0,0,-1,0,0,0,0},        {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},              {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},        {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},        {1,0,0,0,2,0,0,0,0,-1,0,0,0,-1,0,0,0,-1,0,0,0,0,-1,0,0,0,0},        {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},        {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},        {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},        {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},        {-1,0,0,0,-1,0,0,0,0,2,0,0,0,2,0,0,0,1,0,0,0,0,-1,0,0,0,0},               {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},               {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},        {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},        {-1,0,0,0,-1,0,0,0,0,2,0,0,0,2,0,0,0,1,0,0,0,0,-1,0,0,0,0},              {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},               {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},        {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},        {-1,0,0,0,-1,0,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,0,-1,0,0,0,0},        {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,1},        {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},        {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},        {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},                 {-1,0,0,0,-1,0,0,0,0,-1,0,0,0,-1,0,0,0,-1,1,0,0,0,2,0,0,0,1},        {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},        {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},        {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},        {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,1}};


Why do Solve, NSolve, and FindRoot all fail on this simple, solvable actuarial equation?

If we express conditional mortality as a vector of annual probabilities of death, like so               qx1={0.04772, 0.05854, 0.07519, 0.09659, 0.11762, 0.13904, 0.16124,     0.18363, 0.2041, 0.22319, 0.24276, 0.262, 0.27897, 0.29458, 0.31044,     0.32691, 0.34597, 0.36573, 0.38348, 0.39799, 0.40855, 0.41447,     0.41774, 0.42266, 0.43064, 0.43913, 0.44417, 0.44802, 0.45, 0.45};      we can compute the associated survival vector with               lx1=Drop[FoldList[#1 (1 + #2) &, 1, -qx1], -1]      and we can find the median life expectancy of this population with               Length[Select[lx1, # >= .5 &]]      We can combine these two equations into a single function that translates the conditional mortality curve directly into a median life expectancy. It would look like               medianLEfromQx[qx_]:=Length[Select[Drop[FoldList[#1 (1 + #2) &, 1, -qx], -1], # >= .5 &]]      And using the sample data above, we see that the median life expectancy for the population is 7 years. If we want to see the implications of reducing annual mortality by 10%, we can ask               medianLEfromQx[.9*qx1]      And we get an answer of 8 years. Fine. Here lies the problem -- I can't get Mathematica to solve for that multiplier given a desired LE.               Solve[medianLEfromQx[x*qx1]==8,x]      doesn't work (returning an empty set)               NSolve[medianLEfromQx[x*qx1]==8,x]      doesn't work, also returning an empty set, and               FindRoot[medianLEfromQx[x*qx1]==8,{x,1}]      doesn't work either, with the error message that "The Function value {False} is not a list of numbers with dimensions {1} at {x} = {1.}" What am I doing wrong here?


A fast way to compute arrays avoiding If or Which

I found out that if I have to calculate huge arrays with most of the elements being zero( let's say each row has 10000 elements and only 8 are non zero) and the non zero elements' positions being given by an If or a Which, the most straight forward way to go is:               Table[...,{i,1,nn},{j,list[i]}]      instead of               Table[If[MemberQ[list[i],j]==True,...],{i,1,nn},{j,1,nn}]      But the problem is that, list[i] does not fix the position in the array, but only the value, the positions being [1,Length[list[i]]]. Let us ilustrate this with an easy example: Slow way:               A = Table[     Which[MemberQ[{1, 3, 5}, j] == True, 2*i + j, True, 0], {i, 1, 2}, {j,      5}] // MatrixForm     (*(3    0   5   0   7        5    0   7   0   9)*)      Fast way:               B=Table[2*i + j, {i, 1, 2}, {j, {1, 3, 5}}] // MatrixForm          (*(3    5   7        5    7   9)*)      So, I would like to get the matrix A but doing it B way somehow. (The condition for j, is an example, but in the real code is a rather complicated condition that varies with i.) Does anybody see how this could be done? Thanks


How can I convert a plot to pdf or eps without errors?

_Mathematica_ 9.0.1, Linux. I try to save a plot as a pdf. I tried four different options. In each case some errors appeared as blank space ![image 1](http://i.stack.imgur.com/DH4aL.jpg) ( http://yadi.sk/d/h1koyDci4z3rc ). I also tried to save as eps. Another problem appeared -- there is no half letter on the Labels: ![image 2](http://i.stack.imgur.com/1VaSg.jpg) (see here http://yadi.sk/d/OBRDmp3z4z42U ). The same figures are saved very well in _Mathematica_ 7 without an error. Is it possible to solve this problem?


Does Graphics`Mesh`SimplePolygonQ[] work for you?

`Graphics`Mesh`SimplePolygonQ` is an undocumented function. I'm using Mathematica 7, and when I try:               Graphics`Mesh`SimplePolygonQ[{{1, 0}, {0, Sqrt[3]}, {-1, 0}}]       I just get: > Graphics`Mesh`SimplePolygonQ[{{1, 0}, {0, $\sqrt{3}$, {-1, 0}}] I posted a question and a respondent successfully used this function in the code of her answer. Does anyone else have trouble using this function? Any ideas why it won't work for me?


How to paste multiple expression using PasteButton?

Is there a way to paste multiple expressions into notebook using `PasteButton`? For example, I want to do               PasteButton["Inputs", {Defer@(a=1;), Defer@(b=2;)}]      I want the expressions to be shown in multiple lines just as if we are typing them in, not as a list.


Poincaré section for 3BP

I try to plot the Poincaré section for the 3BP i use the following code that works very well:               Needs["DifferentialEquations`NDSolveProblems`"];     Needs["DifferentialEquations`NDSolveUtilities`"];     Clear["Global`*"]     \[Mu]=0.001;     SuperStar[\[Mu]]=1-\[Mu];     Subscript[r1, 1]=Sqrt[(Subscript[y1, 1][t]+\[Mu])^2+Subscript[y1, 2][t]^2];     Subscript[r1, 2]=Sqrt[(Subscript[y1, 1][t]-SuperStar[\[Mu]])^2+Subscript[y1, 2][t]^2];     a=0.298;     b=0.24;     c=0.10;     d=0.40;     tin=0.0;     tfin=60.;     eqns1={{Derivative[1][Subscript[y1, 1]][t]==Subscript[y1, 3][t],Subscript[y1, 1][0]==a},     {Derivative[1][Subscript[y1, 2]][t]==Subscript[y1, 4][t],Subscript[y1, 2][0]==b},     {Derivative[1][Subscript[y1, 3]][t]==2 Subscript[y1, 4][t]+Subscript[y1, 1][t]-(SuperStar[\[Mu]] (Subscript[y1, 1][t]+\[Mu]))/     \!\(\*SubsuperscriptBox[\(r1\), \(1\), \(3\)]\)-(\[Mu] (Subscript[y1, 1][t]-SuperStar[\[Mu]]))/     \!\(\*SubsuperscriptBox[\(r1\), \(2\), \(3\)]\),Subscript[y1, 3][0]==c},     {Derivative[1][Subscript[y1, 4]][t]==-2 Subscript[y1, 3][t]+Subscript[y1, 2][t]-(SuperStar[\[Mu]] Subscript[y1, 2][t])/     \!\(\*SubsuperscriptBox[\(r1\), \(1\), \(3\)]\)-(\[Mu] Subscript[y1, 2][t])/     \!\(\*SubsuperscriptBox[\(r1\), \(2\), \(3\)]\),Subscript[y1, 4][0]==d}};     Orbit=NDSolve[     eqns1,     {Subscript[y1, 1],Subscript[y1, 2],Subscript[y1, 3],Subscript[y1, 4]},{t,tin,tfin},     Method->{StiffnessSwitching,Method->{ExplicitRungeKutta,Automatic}},     AccuracyGoal->8,PrecisionGoal->8,MaxSteps->10000];          myx[t_]:=Evaluate[Subscript[y1, 1][t]/. Orbit];     myy[t_]:=Evaluate[Subscript[y1, 2][t]/. Orbit];          myxplot=Plot[myx[t],{t,0,tfin},AxesLabel->{"time","x"}]     myyplot=Plot[myy[t],{t,0,tfin},AxesLabel->{"time","y"}]          pp1=ParametricPlot[     Evaluate[{Subscript[y1, 1][t],Subscript[y1, 2][t]}/. Orbit],{t,0,tfin},     AxesLabel->{"x","y"},PlotPoints->150]          (*pp2=ParametricPlot3D[     Evaluate[{Subscript[y1, 1][t],Subscript[y1, 2][t],Subscript[y1, 4][t]}/.\[VeryThinSpace]Orbit],{t,0,tfin},     AxesLabel\[Rule]{"x","y","vy"},PlotPoints\[Rule]5000,     DisplayFunction\[Rule]Identity]*)          pp2=ParametricPlot3D[     Evaluate[{Subscript[y1, 1][t],Subscript[y1, 2][t],Subscript[y1, 4][t]}/.Orbit],{t,0,tfin},AxesLabel->{"x","y","vy"},     PlotPoints->4000,MeshFunctions->{#3&},Mesh->{{0}},     MeshStyle->{Directive[PointSize[Large],Red]},     BoxRatios->{1,1,1},DisplayFunction->Identity]          pl1=Graphics3D[     {Green,Opacity[0.9],Polygon[{{-3,-3,0},{-3,3,0},{3,3,0},{3,-3,0}}]},     DisplayFunction->Identity];          Show[pp2,pl1,DisplayFunction->$DisplayFunction,ImageSize->{500,500}]      If you have some problem with subscript You can convert it in standard form, anyway the problem is in the following part of the code (thanks a lot to Belisarius for his very good tips! intersection between function and plane ) that show a section that is different from the one plotted in the last `Show` command. In fact the following command make a section on the, for istance, y-axis (the `y1_2[t]` variable) but i want the section on the z-axis (the `y1_4[t]` variable):               getOneCluster[pts_List,maxDist_?NumericQ]:=(*Returns a cluster*)Module[{f},f=Nearest[pts];     FixedPoint[Union@Flatten[f[#,{Infinity,maxDist}]&/@#,1]&,{First@pts}]]     clusters[data_]:=Module[{f,dist},(*Some Characteristic Distance,assuming no isolated points*)f=Nearest[data];     dist=3 Max[EuclideanDistance[Last@f[#,2],#]&/@data];     Flatten[Reap[NestWhile[Complement[#,Sow@getOneCluster[#,dist]]&,data,#!={}&]][[2]],1]]          p1=ParametricPlot3D[Evaluate[{Subscript[y1, 1][t],Subscript[y1, 2][t],Subscript[y1, 4][t]}/.Orbit],{t,0,tfin},MeshFunctions->{#1&},Mesh->{{0}},PlotStyle->None,MeshStyle->Red];     gc=Cases[p1,GraphicsComplex[__],Infinity];     data=First[(Normal@gc)[[1,2,1,2;;]]/.Point->Sequence][[All,2;;]];     clusters[data];     Show[ListPlot@clusters@data]      Can someone help me to modify this last part of the program to find the correct intersection.


RandomSample Bug?

![Screen Shot of my Mathematica Commands](http://i.stack.imgur.com/focjn.png) I was using RandomSample with very skewed weights. I am asking for a random sample of 6 numbers 1 through 100 without replacement. In the screen shown, the weights for 1 through 6 are 100 000, with all others less then 1; hence, the RandomSample should return numbers 1 through 6 is a random order very very often. But it does not. I have copied and pasted the commands shown. Am I missing something? Or am I misunderstanding the RandomSample function? Or is this actually a bug?


Fit data with linear combinations of Cos and Sin

Recall that if $f$ is a piecewise continuous function on the interval $[-\pi, \pi]$, then the Fourier series of $f$ is $$f(x) = \sum_{n=0}^{\infty} (a_n \cos(nx) + b_n \sin(nx)).$$ See for example, this page. Suppose that I have the following _discrete_ data stored in the List called `list`:               list = {{-6.28319,27.},     {-6.18319,29.9378},     {-6.08319,31.4545},     {-5.98319,31.4815},     {-5.88319,30.054},     {-5.78319,27.3079},     {-5.68319,23.4676},     {-5.58319,18.8269},     {-5.48319,13.7254},     {-5.38319,8.52035},     {-5.28319,3.5588},     {-5.18319,-0.849714},     {-5.08319,-4.45626},     {-4.98319,-7.09014},     {-4.88319,-8.66947},     {-4.78319,-9.20395},     {-4.68319,-8.78975},     {-4.58319,-7.59713},     {-4.48319,-5.85203},     {-4.38319,-3.81336},     {-4.28319,-1.7481},     {-4.18319,0.0934504},     {-4.08319,1.5002},     {-3.98319,2.31839},     {-3.88319,2.46391},     {-3.78319,1.92767},     {-3.68319,0.77379},     {-3.58319,-0.86928},     {-3.48319,-2.82358},     {-3.38319,-4.88107},     {-3.28319,-6.82563},     {-3.18319,-8.45569},     {-3.08319,-9.60509},     {-2.98319,-10.1604},     {-2.88319,-10.0728},     {-2.78319,-9.36378},     {-2.68319,-8.12337},     {-2.58319,-6.50193},     {-2.48319,-4.69555},     {-2.38319,-2.92666},     {-2.28319,-1.42171},     {-2.18319,-0.387886},     {-2.08319,0.00884309},     {-1.98319,-0.337699},     {-1.88319,-1.46055},     {-1.78319,-3.31281},     {-1.68319,-5.76826},     {-1.58319,-8.62934},     {-1.48319,-11.6421},     {-1.38319,-14.5166},     {-1.28319,-16.9518},     {-1.18319,-18.6617},     {-1.08319,-19.401},     {-0.983185,-18.9886},     {-0.883185,-17.3258},     {-0.783185,-14.4076},     {-0.683185,-10.327},     {-0.583185,-5.27092},     {-0.483185,0.492234},     {-0.383185,6.63133},     {-0.283185,12.7772},     {-0.183185,18.5507},     {-0.0831853,23.5918},     {0.0168147,27.5873},     {0.116815,30.2954},     {0.216815,31.5636},     {0.316815,31.3407},     {0.416815,29.6794},     {0.516815,26.7315},     {0.616815,22.7344},     {0.716815,17.9917},     {0.816815,12.8477},     {0.916815,7.66002},     {1.01681,2.7712},     {1.11681,-1.51793},     {1.21681,-4.97054},     {1.31681,-7.43032},     {1.41681,-8.83083},     {1.51681,-9.19685},     {1.61681,-8.63808},     {1.71681,-7.33557},     {1.81681,-5.52246},     {1.91681,-3.4608},     {2.01681,-1.41646},     {2.11681,0.365385},     {2.21681,1.68215},     {2.31681,2.3911},     {2.41681,2.42056},     {2.51681,1.77408},     {2.61681,0.527401},     {2.71681,-1.18153},     {2.81681,-3.16824},     {2.91681,-5.22173},     {3.01681,-7.12679},     {3.11681,-8.6864},     {3.21681,-9.74219},     {3.31681,-10.1909},     {3.41681,-9.99543},     {3.51681,-9.18896},     {3.61681,-7.87251},     {3.71681,-6.20529},     {3.81681,-4.38926},     {3.91681,-2.64914},     {4.01681,-1.20978},     {4.11681,-0.272896},     {4.21681,0.00442148},     {4.31681,-0.472474},     {4.41681,-1.72346},     {4.51681,-3.68806},     {4.61681,-6.22729},     {4.71681,-9.13288},     {4.81681,-12.1433},     {4.91681,-14.9649},     {5.01681,-17.2974},     {5.11681,-18.8597},     {5.21681,-19.416},     {5.31681,-18.7978},     {5.41681,-16.9216},     {5.51681,-13.7988},     {5.61681,-9.53872},     {5.71681,-4.34296},     {5.81681,1.50794},     {5.91681,7.67462},     {6.01681,13.7843},     {6.11681,19.4588},     {6.21681,24.3444}};      Plotting `list` using `ListPlot`, I see:               ListPlot[list, PlotRange -> {-25, 35}, Joined -> True,       PlotStyle -> Directive[Red, Thickness[0.015]]]      ![ListPlot](http://i.stack.imgur.com/wbtLG.png) I know that I can use the `Fit` function to "find a least-squares fit to a list of data as a linear combination of the functions _funs_ of variables _vars_." However, it seems that I can only have a **_single_** coefficient. For example, in the following code, I do three different types of fits:   1. In `cosfit`, I fit `list` to `Cos[n*x]` functions: `cosfit = Fit[list, Table[Cos[n*x], {n, 0, end}], x];`   2. In `sinfit`, I fit `list` to `Sin[n*x]` functions: `sinfit = Fit[list, Table[Sin[n*x], {n, 0, end}], x];`   3. In `cossinfit`, I fit `list` to `Cos[n*x] + Sin[n*x]` functions: `Fit[list, Table[Cos[n*x] + Sin[n*x], {n, 0, end}], x];` However, in the resulting fits, each function has only a single coefficient. For example, the fit of `list` to `Cos[n*x] + Sin[n*x]` (i.e., in `cossinfit`) becomes: $$c_0(\cos[0x] + \sin[0x]) + c_1(\cos[1x] + \sin[1x]) + c_2(\cos[2x] + \sin[2x]) + \ldots,$$ rather than $$a_0\cos[0x] + b_0\sin[0x] + a_1\cos[1x] + b_1\sin[1x] + a_2\cos[2x] + b_2\sin[2x] + \ldots.$$ **My question is,** in the following code, how do I fit to _both_ $\cos$ _and_ $\sin$ (with separate coefficients in front of each $\cos$ _or_ $\sin$ term)?               Grid[      Table[            cosfit = Fit[list, Table[Cos[n*x], {n, 0, end}], x];       sinfit = Fit[list, Table[Sin[n*x], {n, 0, end}], x];       cossinfit = Fit[list, Table[Cos[n*x] + Sin[n*x], {n, 0, end}], x];       {        Show[{          ListPlot[list, PlotRange -> All, Joined -> True,            PlotStyle -> Directive[Red, Thickness[0.015]]],          Plot[cosfit, {x, list[[1, 1]], list[[-1, 1]]}, PlotRange -> All,            PlotStyle -> Black]          }, PlotRange -> {-25, 35}, ImageSize -> 350,          PlotLabel -> "Cos Fit: n = " <> "0.." <> ToString[end]],             Show[{          ListPlot[list, PlotRange -> All, Joined -> True,            PlotStyle -> Directive[Red, Thickness[0.015]]],          Plot[sinfit, {x, list[[1, 1]], list[[-1, 1]]}, PlotRange -> All,            PlotStyle -> Black]          }, PlotRange -> {-25, 35}, ImageSize -> 350,          PlotLabel -> "Sin Fit: n = " <> "0.." <> ToString[end]],             Show[{          ListPlot[list, PlotRange -> All, Joined -> True,            PlotStyle -> Directive[Red, Thickness[0.015]]],          Plot[cossinfit, {x, list[[1, 1]], list[[-1, 1]]},            PlotRange -> All, PlotStyle -> Black]          }, PlotRange -> {-25, 35}, ImageSize -> 350,          PlotLabel -> "Cos/Sin Fit: n = " <> "0.." <> ToString[end]]        }            , {end, {1, 2, 5, 20, 25, 30}}]      ]      which gives this output: ![FitOutput](http://i.stack.imgur.com/gAlyw.png) Is using `Fit` the way to go, or should I use some other built-in Mathematica function? (In actuality, `list` was generated by taking discrete points from the function:               9 Cos[x] + 9 Cos[2 x] + 9 Cos[3 x] + 6 Sin[x] + 6 Sin[2 x] + 6 Sin[3 x]      which I chose as a minimal working example. But in general, I will not know the functional form of the data in `list`, since in general I will obtain `list` from (noisy) empirical measurements.)


Autocomplete from inside Module and SetDelayed

Autocomplete in Mathematica 9 offers suggestions from inside SetDelayed and Module. For example, after running:               func[thing1_, thing2_] := thing1 + thing2;     Module[{thing3},      thing3 = 10;      thing3 + 4     ]      autocomplete will offer `thing1`, `thing2`, and `thing3` as suggestions. Since they are intended to be local, this gets in the way. Is there a way around this?


How to plot a polygon and a line on the same graph?

I have to plot the line 1 + 4 t, 2 + 5 t, 1 + 12 t and the polygon with points {2, 3, 4}, {1, 4, 5}, {3, 3, 3} in the same graph to see if the line goes through the polygon. I was able to get them to plot separately but I cannot get them to plot together. This is what I typed in:               pic1 = ParametricPlot3D[{1 + 4 t, 2 + 5 t, 1 + 12 t}, {t, 0, 12}];     pic2 = p = Polygon[{{2, 3, 4}, {1, 4, 5}, {3, 3, 3}}]     {Graphics3D[{Pink, p}]}     Show[pic1, pic2, PlotRange -> Automatic]      But I get the error: > Coordinate {Skeleton[3]} should be a triple of numbers, or a Scaled form. How do I fix this?


DensityHistogram label/display values in Mathematica 8

I'm trying to make a `DensityHistogram` in _Mathematica 8_ that overlays the histogram values for each location. What I want is for the value of each square to be displayed over it always (i.e. not in the `StatusArea` or as a `Tooltip`). For instance, if you run this code in _Mathematica_ , one of the squares will have a value of 23, and I'd like that value overlaid on that square, and then the same for all the other non-zero values (I don't need a bunch of 0's).               a = {{1.6, 314.1592}, {0.8, 63.6172}, {0.4, 113.0973}, {1, 19.6349}, {1, 19.6349},           {1, 50.2654}, {1, 490.8738}, {1, 19.6349}, {0.045, 17.5}, {0.3, 80}, {0.06, 120},           {1, 100}, {1,78.5398}, {0.06, 120}, {1, 7.0685}, {0.33, 126.6768}, {1, 369.8361},           {0.0008, 0.09}, {1, 1134.1149}, {0.06, 64}, {0.08, 120}, {1, 113.0973}, {0.19, 600},          {1, 283.5287}, {0.00217,14}, {1, 201.0619}, {0.64, 283.5287}, {2, 1520.5308}, {60, 31.4159},          {0.3, 10}, {1, 201.0619}, {1, 283.5287}, {2, 12.5663}, {1, 506.7074}, {0.35, 176.7145},          {0.05, 1.1309}, {2, 1520.5308}, {0.7, 28.2743}, {1, 49}, {1, 100}, {1, 706.8583},          {1, 706.8583}, {8, 3848.451}, {1, 50.2654}, {1, 50.2654}, {1, 314.1592}, {1, 314.1592},          {1, 314.1592}, {1, 314.1592}, {1, 1140.0918}, {2, 314.1592}, {2, 314.1592},           {1.5, 314.1592}, {1, 23.7582}, {1, 15.2053}, {0.02, 0.415}, {1.5, 314.1592},           {1, 254.469}, {0.02, 0.415}, {1, 346.3605}, {0.5, 254.469}, {1, 95.0331}}          DensityHistogram[ a, {{{.0001, .001, .01, .1, 1, 10, 100}},                            {{.01, .1, 1, 10, 100, 1000, 10000}}}, ScalingFunctions -> {"Log", "Log"},                       ColorFunction -> (ColorData["SolarColors"][1 - #] &),                        ChartBaseStyle -> EdgeForm[Thin], BaseStyle -> {FontFamily -> "Arial"},                       Method -> {"DistributionAxes" -> "Histogram"},                       Ticks -> {                         Table[{10^k, Superscript[10, k]}, {k, -4, 4}],                          Table[{10^k, Superscript[10, k]}, {k, -2, 4}]},                        Frame -> {True, True, False, False}, Mesh -> True, ImageSize -> 600,                        LabelingFunction -> (Placed[#1, Above] &)]      I'm not sure if I'm using `LabelingFunction` correctly, probably not. I'd also like to see the relevant values on the axes histograms, if possible.


Equation values into list

Suppose I have a function say $f=x^2$. What I would like is a list (or even better, a list with a grid) which resembles `{{1,1},{2,4},{3,9}, ...}`. Ideally one should be able to specify the starting point, end point and step interval between values. This seem like such a simple idea I don't know why I am struggling with it...


Snapping two "Drawing Tools" objects together while decorating an image

I'm using "Drawing Tools" to decorate an imported image (a TIFF file). I need to create a set of regularly spaced parallel lines, and my solution for doing this is to create a pair of parallel lines (we have an LHS line and an RHS line), copy this pair, superimpose the copied LHS line on the previous RHS line, and then delete the previous RHS line. Doing this repeatedly gives me an array of parallel lines, which are all a fixed distance apart. My question is: while selecting multiple graphics primitives (lines here) how do I snap one primitive to a previously placed primitive decorating the image similar to how one can do this in Adobe Illustrator? Also, is there an easier way for me to automatically generate a set of parallel lines which can be translated / stretched apart using my mouse?


Calculating the Lyapunov Exponent/Spectrum for the Duffing Oscillator

Some fellow students and I are trying to calculate and plot the Lyapunov spectrum for the Duffing oscillator (currently a test approach). Each of us has _Mathematica_ knowledge based purely on past 'need to know' experiences and are having troubles with getting the following code to work.   Can anyone point out where we have gone wrong (probably in multiple places)?               solDuffingOscillator[A_, B_, C_, x0_, x1_, maxt_] :=         NDSolve[{D[x[t], {t, 2}] + 2 A D[x[t], {t, 1}] + B x[t] + x[t]^3 ==            C Cos[ t], x[0] == x0, x'[0] == x1},         {x[t], x'[t]},         {t, 0, maxt},          MaxSteps -> Infinity]        * * *               Manipulate[        Module[{sol1, sol2, X0, V0, X1, V1},         sol1 = solDuffingOscillator[A, B, C, x0, v0, tlim];         X0[t_] = First[x[t] /. sol];         V0[t_] = First[x'[t] /. sol1];              sol2[t_] =           solDuffingOscillator[A, B, C, (X0[t] + dx), (V0[t]), tlim];         X1[t_] = First[x[t] /. sol2[t]];         V1[t_] = First[x'[t] /. sol2[t]];              d = First[Evaluate[{X0}]] - First[Evaluate[{X1}]];         L = 1/dt*Log[d/dx];              Tbl1 = Table[{t, d}, {t, dt, tlim, dt}];         ListPlot[Tbl1, PlotRange -> {{0, tlim }, {-2 Pi, 2 Pi}},          ImageSize -> {1200, 800}]         ],        {{A, 0.5, "A"}, 0, 10, 0.001, Appearance -> "Labeled"},        {{B, -8.54, "B"}, -10, 0, 0.01, Appearance -> "Labeled"},       {{C, 14, "C"}, 0, 20, 0.05, Appearance -> "Labeled"},        {{dt, 1, "dt"}, 0.001, 1, 0.0001, Appearance -> "Labeled"},        {{x0, 1, "x0"}, -2, 2, 0.01, Appearance -> "Labeled"},        {{v0, 0, "v0"}, -1, 1, 0.0001, Appearance -> "Labeled"},        {{dx, 0.5, "dx"}, -0.5, 0.5, 0.001, Appearance -> "Labeled"},        {{tlim, 1000, "t Cutoff"}, 100, 4000, 5, Appearance -> "Labeled"}]


DSolve will not apply assumption `m ∈ Integers`

I am trying to solve a linear second order ODE using `DSolve` which involves an arbitrary integer `m`. `DSolve` gives me a solution when I set `m` to a particular integer (I have tried several, including negative/positive, even/odd, and `0`). When I try to use the assumption `m ∈ Integers` and ask `DSolve` to solve this ODE for an arbitrary integer `m`, it does not work. Here is the input:               $Assumptions = m ∈ Integers     testk =        0 == -16 c m^2 Cos[x] k[x] - c (-7 Sin[x] + Sin[3x]) k'[x]             + Cos[x] Sin[x]^2 (m^2 (3 + 4 m Cos[x] + Cos[2 x]) Tan[x/2]^(2 m) + 4 c k''[x])          DSolve[ testk, k[x], x]      > >     DSolve[ 0 == -16 c m^2 Cos[x] k[x] - c (-7 Sin[x] + Sin[3 x]) k'[x] >                   + Cos[x] Sin[x]^2 (m^2 (3 + 4 m Cos[x] + Cos[2 x]) > Tan[x/2]^(2 m) >                   + 4 c k''[x], k[x], x] >   Update: I have realized that the problem is that `DSolve` does not apply any of the global assumptions. Does anyone know how I can make `DSolve` apply the assumption that `m ∈ Integers`? I have tried using `Assuming[,]` to set the assumptions locally but that did not work either.


How do I get the length of held list without evaluating the list?

I used `Extract` with `Hold` to retrieve a sublist containing expressions I didn't want evaluating, _e.g._               foo = Extract[OwnValues[test], {1, 2}, Hold]     (* Hold[{expr1, expr2, expr3}] *)      I'm sorry to ask such a trivial question, but, how do I get the length of that list? Obviously `Length@foo` returns `1` because the top-level head is `Hold`. But attempting to access the lower levels seems to cause evaluation one way or another. What technique am I missing?


How can I find a root of my transcendental equation near a certain point?

What function could I use to solve this equation for x:               E^(-x^2) = 1 - Cos[x]      I tried `Solve`, `Reduce`, `Root`... None of them worked. `FindInstance` gave me an imaginary answer. Adding `Reals`, gave me:               {{x -> Root[{-1 + E^-#1^2 + Cos[#1] &, -6.28318531096301494721675292506}]}}      but this is not the answer I wanted, which would be between 0 and 1. How would I solve this? As a side note, WolframAlpha got it.