Strange opacity behavior

I edited my question and included the code: here I make the general definitions for the parametric plots I have to do later (these are simply the definitions of the x and y coordinates of the points in the region, there are no problems here):               ClearAll["Global^*"];          ClearSystemCache[];          eU2[heU2_?NumericQ] = (Sin[heU2])^2/(2 *(1 - Cos[heU2])^2);          zU2[hzU2_?NumericQ] = Cos[hzU2]/(1 - Cos[hzU2]);          hU2end[cU2end_?NumericQ] = ArcCos[(2*cU2end^2 - 1)/(2*cU2end^2 + 1)];          hU2cmbt[cU2cmbt_?NumericQ, oU2cmbt_?NumericQ, eFU2cmbt_?NumericQ] =      2*ArcCos[(Cos[oU2cmbt/2])*E^(-(eFU2cmbt/(2*cU2cmbt^2)))];          hU2cmb[cU2cmb_?NumericQ, eFU2cmb_?NumericQ] =      hU2cmbt[cU2cmb, oU2cmb, eFU2cmb] /. oU2cmb -> hU2end[cU2cmb];          nsU2[cnsU2_?NumericQ, eFnsU2_?NumericQ] =      1 + 2*cnsU2^(-2)*zU2[hU2cmb[cnsU2, eFnsU2]] -      6*cnsU2^(-2)*eU2[hU2cmb[cnsU2, eFnsU2]];          rU2[crU2_?NumericQ, eFrU2_?NumericQ] =      16*crU2^(-2)*eU2[hU2cmb[crU2, eFrU2]];      Having defined these functions, I define a color to be used later:               CoolColorU2 = ColorData["CMYKColors"];      Now I do the parametric plot:                PlotU2Treh =       ParametricPlot[      Evaluate[{nsU2[CCU2Treh, NNU2Treh],       rU2[CCU2Treh, NNU2Treh]}], {CCU2Treh, 5, 50}, {NNU2Treh, 49, 62},       PlotRange -> {{944/1000, 969/1000}, {25/1000, 180/1000}},       AspectRatio -> 1/GoldenRatio,       ColorFunction ->       Function[{x, y, CCU2Treh}, Opacity[1/3, CoolColorU2[CCU2Treh]]],       ColorFunctionScaling -> {True, True, True,      BoundaryStyle -> None, Axes -> False,       LabelStyle -> Directive[11, FontFamily -> "Palatino"],       FrameLabel -> {"lll",       "hhh"}, WorkingPrecision -> 6,       PerformanceGoal -> "Quality"]      The problems here are the following: 1) when I export this Image in .pdf, I get the result shown in the figure below (.tiff conversion from Mac Preview, cannot upload .pdf) ![enter image description here](http://i.stack.imgur.com/3Kj7s.png) that is there are some "lines" between the "rectangles" of the underlying mesh, that form a "strange tiling" on my surface. 2) when exporting to .pdf, Mathematica gives me a file of the order of MB (when it doesn't crash upon exporting, that is half of the time). Why so heavy (correction: this seems to be the case only when I add with "Legended" some legends I did with "BarLegend" and "SwatchLegend")? 3) when trying to "zoom" with "Show" and "PlotRange" i get the following image (again, converted to .tiff with Preview) ![enter image description here](http://i.stack.imgur.com/8vq27.png) and the "problem" is that the plot seems to "leak out" when encountering the x axis. How can I avoid this? So in the end there are two questions: a) why if I plot the first parametric region with a "color gradient" that "strange tiling" appears? b) why does the image "leak out" from the borders upon zooming in? Thank you, hope to hear from you soon. Giovanni P.S.: Mathematica version: 9.0.0. Laptop: MacBook OS X 10.9.2 Mavericks, 2.2 GHz Intel Core 2 Duo, 4 GB DDR3 **_EDIT_** : solved two thirds of the question, last problem remains. Ok I think I solved the "b)" problem. Going through the docs I saw that for PlotRange settings other than "All", "Full" and "Automatic", the "PlotRangePadding" option is set to none. If I set PlotRange to "All", "Full" or "Automatic", instead, there is a 4% padding. So I think that I just have to add the "PlotRangePadding" option myself. So, there is only the problem "a)" left: I tried to use               Method->{"TransparentPolygonMesh"->True}      as was suggested in Removing unwanted appearance of underlying mesh and Using transparency in ContourPlot makes mesh visible but when I export the graphic to .pdf, the problem remains.


StreamPlot with interpolating functions

While working my way through the Wolfram Blog post on simulating fluid flow I started playing with `StreamPlot` because I preferred quick and ugly visualizations over the `ListIntegralConvolutionPlot` which simply tested my patience. When using `StreamPlot` with the interpolated velocity vectors, however, the function would throw an error: > InterpolatingFunction::dmval: Input value {1.05051,1.05051} lies outside the > range of data in the interpolating function. Extrapolation will be used. >> An example that reproduces this error is:               u = Interpolation[       Flatten[Table[{{x, y}, -1 - x^2 + y}, {x, 0, 1, 0.1}, {y, 0, 1,           0.1}], 1]]     v = Interpolation[       Flatten[Table[{{x, y}, 1 + x - y^2}, {x, 0, 1, 0.1}, {y, 0, 1,           0.1}], 1]]     StreamPlot[{u[x, y], v[x, y]}, {x, 0, 1}, {y, 0, 1}]      It looks like a similar issue was observed in earlier versions of Mathematica with `LogLinearPlot`. Following a similar troubleshooting process:               Reap@StreamPlot[{Sow[x], Sow[y]}, {x, 0, 1}, {y, 0, 1}];     %[[2]]      shows (I think, I'm not terribly comfortable with Reap/Sow) that `StreamPlot` is polling the function at 1.05051.               {{1.05051, 1.05051, 1.05051, 1.05051, 0.,...}      Furthermore, the polling seems independent of the range for x or y supplied in the function. In the end, the plot that is displayed with interpolated values is identical to the one made with the original equations (in this case). My concern is that this behavior may impact a subset of interpolated functions that do behave badly outside of their defined region and it would be good to be able to tell `StreamPlot` that. Is it possible or is this a bug that we'll be stuck with until version 10 comes out?


Eigenvector corresponding to a specific eigenvalue already found earlier

just a quick question that is very simple but somewhat hard to explain. I am using 4 specific eigenvalues of a large 80x80 k-dependant matrix. I found the 4 eigenvalues of interest for various k and sorted them in 4 distinct lists as need them. Now I am interested in their eigenvectors. My question is, is there a way, other than Solve, to get the eigenvector to ONE specific eigenvalue. I guess I could use Eigensystem, let Mathematica find all 80 again and the pick the EVec corresponding to the Eval already found. This seems somewhat stupid though, because I don't need the 79 others. On the other hand Solve looks also like overcomplicating the problem as well, as I am not using an inbuilt Algorithm to find Eigenvectors anymore. Besides my first tries here weren't successful at all, giving me error messages saying something about badly conditioned matrices giving large numerical error. Help would be much appreciated! Thanks EDIT1: Using Eigensystem showed me that the results for eigenvalues by Eigenvalue are different in the 16th digit than the results for Eigensystem!! Why is that! And how to get around that?


What's the difference between this differentiation?

I've tried to evaluate a sum and get a result in terms of `Zeta` function. And I have results in two forms:               (Zeta^\[Prime]\[Prime])[3/2]      And this:               Zeta''[3/2]      I tried to evaluate it, but the result is interesting:               N[(Zeta^\[Prime]\[Prime])[3/2]]     (* 15.9896 *)          N@(Zeta^\[Prime]\[Prime])[3/2]     (* 15.9896 *)          N[Zeta''[3/2]]     (* 15.9896 *)          N@Zeta''[3/2]     (* (Zeta^\[Prime]\[Prime])[3/2] *)      The question is: why the last one being unevaluated?


Why can't I remove the {0, 0} in Circle[{0, 0}] using pattern matching?

Why does               Circle[{0, 0}] /. List[_?NumericQ ..] :> Sequence[]      return > Circle[{0, 0}] yet               Circle[{0, 0}] /. List[_?NumericQ ..] :> List      returns > Circle[List] ?


Extract Style Attributes from Style[]

Can you extract the Style attributes from a variable. For example:               var = Style["aString", Bold, 24]      You can get back "aString" by using ToString[var] but I am not able to get the attributes {Bold, 24}.


Finding numerical/analytic solution to a derivative

Consider the following system of equations, with 11 dependent variables:               seq={     f - h (1*^8 r + 200 + 10) - (25. g h)/(g + 244 h) == 0,     (25. g h)/(g + 244 h) - (3.7*^-5 gs)/(4.9*^-5 + gs) == 0,     g == 0.0032 - 2 gs,     rt == 701 r,     oht == 701 oh,     sst == 701 ss,     h r == 2.1*^-3 sst tr,     oht == 3.85*^8 h r,     701 (oh + r + ss) == 5.7*^-4,     sst tr == (0.41*^-6 to)/(1.48*^-6 + to),     to == 6*^-7 - tr     };      I am trying to find the numerical value of the derivative `(dh/df)*(f/h)` around a certain value of `f = 5*^-9`. To do so, I could first find the numerical solution to the equations using `FindRoot` (fairly easy to do), and then replacing the numerical value of variables `g` and `r` in equation > >     f - h (1*^8 r + 200 + 10) - (25. g h)/(g + 244 h) == 0 >   while leaving `h` and `f` unevaluated and then compute the derivative. Yet, because those other variables (`r` and `g`) also change with `f`, I can't compute this just numerically like this. Yet, finding the analytic solution to the equations above is not feasible as the system is too big for mathematica to find such solution (the sample above is just a small part of the real system). So, I was thinking, whether there would be a way for me to compute the derivative at the top numerically. I am probably just complicating things, and most likely there is a rather trivial way of solving this - yet, I am not seeing it. Could you guys help me out please?


Problem with PlayerPro recognizing a proprietary package

This question follows on from my earlier question Can Wolfram's Player Pro Use Proprietary Packages. That question appeared to have established that, yes, **PlayerPro** can use proprietary packages. Hmmm....? I've got two problems (to start) one of which I'll describe here and the second in a separate question. I purchased a **PlayerPro** license ($200 USD) for OS X to evaluate what it really can and does do. I installed it on a machine that had no other Mathematica installation. I tested its installation and functionality by running a couple of simple completely self-contained `CDF`s on it without any trouble. I then transferred copies of three files to the **PlayerPro** equipped machine and located them in the following directories: > /Users/username/Library/MathematicaPlayerPro/Applications. **myPackage.m** > /Users/username/Library/MathematicaPlayerPro/Applications. **myNotebook.nb** > /Users/username/Library/MathematicaPlayerPro/Kernel. **init.m** **myPackage.m** holds proprietary functions. **myNotebook.nb** provides a `Grid` of `InputField`s and a `Button` to execute code contained in **myPackage.m**. All of its code resides in an initialization cell (but that starts to get into my next question). **init.m** contains the following code:               (** User Mathematica initialization file **)     Get["myPackage`"]      The comparable deployment on my machine running Mathematica works perfectly. On the PlayerPro machine, not so much. I have shut down and restarted PlayerPro and the problem persists. I have rebooted the machine, launched PlayerPro and the problem persists. Upon opening **myNotebook.nb** , I can see plainly that none of the function names from **myPackage.m** have run. They all remain blue. The package has not loaded automatically. As the notebook depends almost entirely on the code in the package nothing in it executes. Neither does it appear that the initialization cell runs. I then went into:               PlayerPro >>> Preferences >>> System >>> Edit Trusted Directories      and specifically added the: > .../MathematicaPlayerPro/Applications > > .../MathematicaPlayerPro/Kernel directories, restarted, rebooted, still nothing. Does anyone have any ideas of how to get this working? I've actually phoned Premier Support about this. The did not have a ready answer. If I hear anything useful from them I'll post it. **Update 1** : I have used `Encode` to encode the package in question. I have made the assumption that the `init.m` package would not require encoding. Perhaps that assumption needs reexamination. **Update 2** : Encoding `init.m` has no affect. **Update 3** : I created a notebook to test the following two lines of code for loading the package:               Get["myPackage`"]          $Failed          Get["Users/username/Library/MathematicaPlayerPro/Applications/myPackage`"]          Get::noopen : Cannot open Users/username/Library/MathematicaPlayerPro/Applications/myPackage`     $Failed      I have also tried:               Needs["myPackage`"]     Needs::nocont : Context myPackage` was not created when Needs was evaluated.          $Failed              `Needs["myPackage`,"Users/username/Library/MathematicaPlayerPro/Applications/myPackage`"]               Get::noopen : Cannot open Users/username/Library/MathematicaPlayerPro/Applications/myPackage`     Needs::nocont : Context myPackage` was not created when Needs was evaluated.           $Failed      **Update 4** : Premier Support suggested some of the same things that Albert does in his answer below (still working through all of Albert's suggestions). They did discover something peculiar with PlayerPro: > I know that the main difference between this procedure and what you may have > been doing with your package is that you have your Needs/Get statement > inside of the PlayerPro init.m file. I did try doing the same, and found > that it did not load the package. I will check on this issue with our > developers to get more information. **Update 5** : Sorry for all these updates, but this now appears like a bug in (at least) PlayerPro 9.0.1.0. The init.m file whether encoded or not simply doesn't do its job, at least not in anyway similar to how it works in full blown Mathematica. I have successfully found a workaround (but not a happy one), with the generous assistance of both answers made to this question. Still, having Wolfram provide either a fix or at least a readily available explanation of why it differs in PlayerPro from Mathematica would save a lot time and frustration.


Wolfram Workbench problem with JLink

I'm working on Wolfram Workbench 2.0 and I'm creating a JLink Application project. Below there is the code:                   BeginPackage["Snake`", {"JLink`"}]         (* Exported symbols added here with SymbolName::usage *)          Begin["`Private`"]         (* Implementation of the package *)         InstallJava[]         ButtonClickHandler1[_]:=           JavaBlock[             filedialog = JavaNew["java.awt.FileDialog","Choose an image file"];             filedialog@setVisible[True]           ]         actionListener1 = JavaNew["com.wolfram.jlink.MathActionListener"];         myWindow = JavaNew["javax.swing.JFrame","Snake"];         myWindow@setSize[1200, 600]         myWindow@setLocation[45, 100]         buttonLoad = JavaNew["javax.swing.JButton", "Load Image"];         buttonLoad@setSize[105,20]         buttonLoad@setLocation[350,400]         actionListener1@setHandler["actionPerformed", "ButtonClickHandler1"]         buttonLoad@addActionListener[actionListener1]         buttonRun = JavaNew["javax.swing.JButton", "Run Snake"];         buttonRun@setSize[95,20]         buttonRun@setLocation[475,400]         cbShowAnim = JavaNew["javax.swing.JCheckBox", "Show animation"];         cbShowAnim@setSize[120,20]         cbShowAnim@setLocation[585,400]         labelImage = JavaNew["javax.swing.JLabel", "Snake"];         labelImage@setSize[1200,300]         labelImage@setLocation[0,0]         txtMaxiter = JavaNew["javax.swing.JTextField","300",3];         txtMaxiter@setSize[28,25]         txtMaxiter@setLocation[805,400]         labelMaxiter = JavaNew["javax.swing.JLabel", "Max. Iteration:"];         labelMaxiter@setSize[100,20]         labelMaxiter@setLocation[715,400]         labelGradThre= JavaNew["javax.swing.JLabel", "gradient thresold:"];         labelGradThre@setSize[100,20]         ...         JavaShow[myWindow]         End[]         EndPackage[]      Wolfram Workbench returns the following error: > The class com.wolfram.jlink.MathActionListener cannot be found. Probably, Wolfram Workbench doesn't find the JLink package. How I can solve this problem?


How can I find English words among the names of the characters in the Mathematica character set?

I want to find some single meaningful words in the "ASCII/Unicode" form characters. For example, I want to get `alpha` from `\[Alpha]`.               \[Alpha] // FullForm      > >     \[Alpha] >   here there are two ways: ## method 1 * * * Obtain all `FullForm` such characters list, and get the words, and check the validity/               {"\[Alpha]", "\[Function]", "\[Beta]"} // FullForm      > >     List["\[Alpha]","\[Function]","\[Beta]"] >                 wordlist = StringCases[                 ToString[FromCharacterCode[Range[0, 200]], CharacterEncoding -> "ASCII"],                   Shortest["\\["~~x__~~"]"] /;(Length@DictionaryLookup[x, IgnoreCase -> True]                                                                 >= 1) -> x                           ]      > >     {Cent,Sterling,Currency,Yen,Section,Micro,Paragraph} >   The above code becomes too slow at `Range` is `20000`, so how to speed up it, and extend the characters(some maybe not in `FromCharacterCode[Range[0,65536]`) such like "`\[Function]`" this is the **question1** . ## method 2 * * * I have a `wordlist` to check the validity. For example, `alpha`, then convert it into the right string form. we can check by `ToExpression`, the problem is `ToExpression` sometimes returns too many errors for some wrong string. Something like a function `SyntaxQ`(which failed at such characters `\[Function]`)               SyntaxQ["\\[Function]"]      > >     False >                 wordlist = "\\["<>StringJoin[MapAt[ToUpperCase, Characters[#], 1]]<>"]" & /@                     DictionaryLookup["*"];          Select[wordlist, SyntaxQ] // Union      > > > {\[Alpha],\[Andy],\[Angle],\[Angstrom],\[Bet],\[Beta],\[Breve],\[Bullet],\[Cedilla],\[Cent > > ],\[Chi],\[Continuation],\[Copyright],\[Currency],\[Dagger],\[Dash],\[Degree],\[Delta],\[D > > iameter],\[Earth],\[Ellipsis],\[Epsilon],\[Eta],\[Euro],\[Flat],\[Florin],\[Gamma],\[Hyphe > > n],\[Infinity],\[Iota],\[Jupiter],\[Kappa],\[Lambda],\[Mars],\[Mercury],\[Micro],\[Moon],\ > > [Mu],\[Natural],\[Neptune],\[Nu],\[Null],\[Omega],\[Omicron],\[Paragraph],\[Phi],\[Pi],\[P > > laceholder],\[Pluto],\[Prime],\[Psi],\[Rho],\[Rupee],\[Saturn],\[Section],\[Sharp],\[Sigma > > ],\[Spooky],\[Sterling],\[Stigma],\[Sun],\[Tau],\[Theta],\[Thorn],\[Trademark],\[Upsilon], >     \[Uranus],\[Venus],\[Villa],\[Wolf],\[Xi],\[Yen],\[Zeta]} >                 % // Length      > >     73 >   So, I just found 73 words, that's too little. I think/hope there is a list(maybe some files) for such "ASCII"/Special characters. **question2** is to set up from a `wordlist` I wanna to check. ## References * * * Of course we can import such help pages to get all such words, but I'd like some way like `Names["*"]` to get all such codes, that's much faster. guide/SpecialCharacters


Monitoring the Evaluation of NDSolve: time to finish estimation

My problem is quite simple: I run a `NDSolve` with a system of many ODEs, a calculation that will run for many hours, and I would like to know the progress of the calculation while it goes on. More precisely, calling `f[n][t]` the functions to be solved in the interval `{tin,tfin}`, It will be sufficient to print at regular intervals `t` the value of `Sum[f[n][t]]` for example, and possibly to save them as well. As a side effect, this will also give me an idea of when the calculation is going to end. However I don't want to sacrifice a significant amount of runtime for this monitoring. One option could be really to split the calculation in intervals (a table of `NDSolve`) and print the intermediate results at each point. But I am afraid to have a significant overhead due to the reconstruction of the system of equations every time (I also use the method `"EquationSimplification"->"Solve"` which I believe transforms symbolically the system before integrating it) so I hope that some wizards among you could help me out providing an efficient solution to this problem using perhaps `EvaluationMonitor` or `EventLocator` or `StateData` ? Any example will be appreciated. EDIT: here is an example I just invented (the real example is more complicated).               M = 100;     Clear[P];     eqns := Table[        P[k]'[t] == -(1/k) P[k][t] -           P[k][t]^2 Sum[Exp[-(k - q)^2/M] P[q][t], {q, 1, M}]        , {k, 1, M}];          initial = Table[P[k][0] == 0.2, {k, 1, M}];          spos = NDSolve[Join[{eqns, initial}],         Table[P[k], {k, 1, M}], {t, 0, 100},         Method -> {"EquationSimplification" -> "Solve"},         PrecisionGoal -> 3, AccuracyGoal -> 3];


How to programmatically create a Manipulate in another Manipulate?

Background: the following Manipulate works as expected                db := {{1, 10, 11}, {2, 20, 21}, {3, 5, 11}, {4, 15, 11}, {5, 8, 21}};      Manipulate[        Manipulate[ {a, 1, db[[x, 2]]}, {a, 1, db[[x, 2]]}],      {{x, 1}, 1, 5, 1}]      Now I want to make the inner-Manipulate more flexible... I tried this:                Manipulate[        Manipulate[s, {a, 1, db[[x, 2]]}] /. s -> {a, 1, db[[x, 2]]},      {{x, 1}, 1, 5, 1}]      Where s is supposed to be entirely variable based on some value in the outer- Manipulate, but it fails. Question: I want to programmatically build a(n inner-)Manipulate from values selected in an (outer-)Manipulate. Is this possible, if so how? UPDATE: I modified Piilsy's answer so that it works as follows:                Manipulate[       Manipulate[         Column[Table[{##}[[i, 1, 1]], {i, 1, Length[{##}]}]], ##]          & @@Table[{{x[i], 0.5}, 0, 1}, {i, 1, n}],       {n, Range[6]}]      **Question:Can this code be enhanced, i.e. made clearer?**


Plotting a simple relationship with Plot[] results in empty graph

I've moved this question over from StackExchange to get better visibility (and deleted the old question). I have a user-defined relationship I'd like to plot:               a = (b + c)/d;      and I try to plot it as follows:               plotFunction[b_, c_] := Plot[a, {d, 0, 10}];     plotFunction[2, 3]      This results in an empty plot; only the axes are drawn. Of course the following works fine:               plotFunction[b_, c_]:= Plot[(b + c)/d, {d, 0, 10}];     plotFunction[2, 3]      I don't understand why MMA refuses to draw the function in the first method? I've tried using Show[] as well; no luck. I even tried passing the relationship within the function as follow - no luck:               plotFunction[a_, b_, c_]:= Plot[a, {d, 0, 10}];     plotFunction[a, 2, 3]      I suppose it could have something to do with local vs global variable definitions inside and outside the function definitions?


Plot basins of attraction using separatrices for particular pendulum

How can I plot the stable and unstable separatrices to make a graphic of the basins of attraction of this differential equation?               y'[t] == Cos[t] - Sin[x[t]] - 0.1 y[t], x'[t] == y[t]      I used as a reference this paper from hubbard and I think I can draw the different basins of attraction using separatrices. I'm using this Poincarè map:               P[{a_, b_}, tmax_] := {x[tmax], y[tmax]} /. First[NDSolve[     Join[{y'[t] == Cos[t] - Sin[x[t]] - 0.1 y[t],        x'[t] == y[t]}, {x[0] == a, y[0] == b}], {x, y}, {t, 0, tmax}]]      and I did plot one of the basins as points with this:               (*It will take a little bit of time to see the graphic*)     test = NestList[P[#, 4 \[Pi]] &, {1, 1}, 5000];     cb = Last[test]     pointlist =        Compile[{{a, _Real}, {b, _Real}},         FixedPointList[P[#, 2 \[Pi]] &, {a, b}, 8000,          SameTest -> (Abs[#1[[1]] - #2[[1]]] < 0.1 &&              Abs[#1[[2]] - #2[[2]]] < 0.1 &)]];     listofpoint =         Cases[Flatten[          Table[If[            Abs[cb[[1]] - Last[pointlist[a, b]][[1]]] < 0.1 &&              Abs[cb[[2]] - Last[pointlist[a, b]][[2]]] < 0.1,             pointlist[a, b], {x}], {a, -5, 5, 0.1}, {b, -5, 5, 0.1}],           1], Except[{x}]];     ListPlot[listofpoint, PlotStyle -> {PointSize[Tiny], Red},       Background -> Black]      I think that I have to find the saddle points to draw at least one basin but I'm stuck. On a side note I used the following method for the Duffing equation but in this case it didn't work:               Duffing = {x'[t] == y[t], y'[t] == 0.5 x[t] - 0.5 x[t]^3 - 0.015 y[t]};     {x, y} /.       Solve[Thread[(Last /@ Duffing /. a_[t] :> a) == {0, 0}], {x, y}]     separatrix = ({x[t], y[t]} /.            First[NDSolve[{Duffing, x[0] == #[[1]], y[0] == #[[2]]}, {x[t],               y[t]}, {t, -133, 0}]] &) /@ {{0, -0.001}, {0, 0.001}};     sepPlot =       Show[ParametricPlot[Evaluate[separatrix[[1]]], {t, -132.6, 0}],        ParametricPlot[Evaluate[separatrix[[2]]], {t, -129.5, 0}],        Axes -> None, Frame -> True]     data = Cases[sepPlot, _Line, \[Infinity]] /. Line -> List;     Short[data, 5]     Graphics[{Yellow, Rectangle[{-1.7, -1}, {1.7, 1}], Blue,        Polygon[Join[data[[1, 1]], Reverse[data[[2, 1]]]]],        PointSize[0.02], {GrayLevel[1], Point[{1, 0}]}, Point[{-1, 0}]},       Frame -> True, FrameTicks -> {Automatic, Automatic, None, None},       PlotRange -> {{-1.7, 1.7}, {-1, 1}}, PlotRangeClipping -> True]      P.S:I'm using Mathematica 8.0


Align Array Plots

I have two `ArrayPlot`s that I would like to align but my "tweaking" failed yet. I would like each "row" to be aligned.               lista = RandomReal[{0, 1}, 10];     listb = Table[RandomReal[{0, 1}, 10], {1000}];          Row[{ArrayPlot[{Table[0, {Length@lista}], lista}\[Transpose],                      Frame -> False,                     AspectRatio -> 6/1,                      ImageSize -> {100, 700}],           ArrayPlot[listb\[Transpose],                     AspectRatio -> 3.5/6,                     ImageSize -> {1200, 700},                     Frame -> False]}]      ![enter image description here](http://i.stack.imgur.com/X2kI7.png)


solving series of matrices by simply multiplication

I have a number of matrices `{2*2}` containing element in series ....so by what method I solve that ...               mat.{A (i), B (i)} == {A (i + 1), B (i + 1)}     Solve[%, {A (i + 1), B (i + 1)}, {i, 0, 20}]


Corrected: Solve[] cannot solve simple hyperbola equations?

Is Solve[] very inefficient in solving equations involving square roots? The input below attempts to find out the explicit expression of either x or y in terms of other variables {x|y, a, c}, and c is the focal length, a is directrix. F = (Sqrt[(x+c)^2+y^2]-Sqrt[(x-c)^2+y^2]==2a && x>0 && c>0 && a>0 && c>a) Solve[F,y] Solve[F,x] After running on my Acer dual core laptop for over 4 hours this input is still shown in “running” state. http://reference.wolfram.com/mathematica/ref/Solve.html “Solve deals primarily with linear and polynomial equations.” So is the equation above an example that Solve[] works not so well with equations involving square roots (and likely other order roots) ?


More complete "MutipartData" POSTs using URLFetch

I'm trying to upload a file to a wiki using Mathematica's URLFetch. Some preliminary work is required - one needs to log in to the wiki, obtain an edit token, and exchange some cookies with the wiki server. URLFetch can handle all of that. But then for the actual file upload, the MediaWiki API (e.g. http://www.mediawiki.org/wiki/API:Upload) specifies that one has to use the POST method with Content-Type=multipart/form-data, but the Mathematica implementation of multipart within URLFetch seems to be incomplete. The Mathematica documentation of the option "MultipartData" of URLFetch says only: > to upload multipart data, each part must be of the form > {name,mimeType,{bytes}}, where {bytes} is a list of bytes This suggests that in the "Content-Disposition" header of each part of a multipart request, a name can be specified as in: > Content-Disposition: form-data; name="file" but there seems to be no way to also specify a filename, as in > Content-Disposition: form-data; name="file"; filename="Apple.gif" Finally, the MediaWiki API requires that a file name be specified; see e.g. the example of a multipart request at the very bottom of http://www.mediawiki.org/wiki/API:Upload (and when I try to upload a file without specifying a filename, the wiki server sends back an error message). So my question: Is there a more complete implementation of the MultiPart protocol with URLFetch?


Reversing one axis in Plot3D

When I rotate my 3D plot to the desired viewpoint my X axis runs from 1 at the left to 0 at the right. How can I mirror my plot so that 0 will be at the left and 1 at the right? Extra credit: how can I get the `ViewPoint` vector after manual rotation?


New integration symbol

Is there a way to introduce a new integration symbol? Specifically I want to be able to use ⨍. I have no problem entering it into mm, but the size does not change like the standard \int does.


AxesLabel in RegionPlot does not work

I simply want to add labels to the axes without using the Drawing Tools menu, I tried this without success: `RegionPlot[x^2 + y < 3, {x, 0, 3}, {y, 1, 3}, AxesLabel -> Automatic]` This does not work either: `RegionPlot[x^2 + y < 3, {x, 0, 3}, {y, 1, 3}, AxesLabel -> {x, y}]` Is there any convenient way of labelling axes in a region plot? Thanks for your help!


How do I convert Mathematica's suggestions to usable code

I enter an image and in the suggestions bar under the image, one of the suggestions is "Edge detect". I click on it and a nice cell with all the options comes up. How do I get the code for all of what _Mathematica_ returns? Clicking "Done" merely returns the value of the variables on the sliders.


Big spaces between legend positions

I am trying to make a legend for my plot. Actually, I made one, but I cannot understand why there are such big spaces between the legend positions.               Graphics[Legend[{        {Graphics[{CapForm[None], Red, Thickness -> 0.05,            Line[{{0, 1}, {1, 1}}]}], "A"},        {Graphics[{CapForm[None], Blue, Thickness -> 0.05,            Line[{{0, 1}, {1, 1}}]}], "B"},        {Graphics[{CapForm[None], Green, Thickness -> 0.1,            Line[{{0, 1}, {1, 1}}]}], "C"}        }, LegendTextSpace -> 0.25]]      Results in: ![wrong legend](http://i.stack.imgur.com/kBdpQ.png)


Improve performance for finding Fibonacci number which have divisibility property

In this post, the OP requires finding a Fibonacci number having some divisibility property with _Mathematica_ and _Maxima_. I ~~tired~~ tried that Mathematica code on Mathematica 9.0 and it's still slow (about 100 seconds). Can we improve the Mathematica implemention?               fibRatio[a_, b_] := FullSimplify[Sum[Fibonacci[n + i], {i, 0, a}]/Fibonacci[n + b]]          Select[      Flatten[Table[{a, b, fibRatio[a, b]}, {a, 1, 10}, {b, 1, a}], 1],      IntegerQ[#[[3]]] &      ]


How to instruct FullSimplify to assume that PossibleZeroQ returns correct result?

Sometimes I have a really huge expression that cannot be significantly simplified by `FullSimplify`. I would like to, so to speak, _"simplify with faith"_ using heuristics applied by functions like `PossibleZeroQ`, `FindSequenceFunction` an so on. Is it possible to instruct `FullSimplify` to use non-rigorous methods like this?


Solving a complex-valued differential equation with NDSolve

I am trying to solve $dx/dt=\sqrt{1+(ix)^{1.8}}$ for initial condition $x[0] =-0.9877 + i 0.1563$, where $x$ is a complex variable. I would like to plot the imaginary part of the solution versus the real part. I used `NDSolve` and `ParametricPlot`.               s1 =        NDSolve[{x'[t] == (1 + (I x[t])^1.8)^0.5, x[0] == -0.9877 + I 0.1563}, x[t], {t, 0, 10},          Method -> "ExplicitMidpoint", "StartingStepSize" -> 1/1000];          ParametricPlot[Evaluate[{Re[x[t]], Im[x[t]]} /. s1], {t, 0, 10},        PlotRange -> Full, AspectRatio -> 1]      The result is wrong. I expect some kind of spiral. I think the problem is due to the fact that the graph crosses the branch cut which emanating from the origin. How can I fix it? P.S.: I expect something like ![enter image description here](http://i.stack.imgur.com/G3C0X.png)


Error with String patterns producing Removed["$$Failure"]

While working on How to capitalize the first letter of each word in a string and trying to understand why certain characters were not considered letters I tried this:               StringCases["áéíóöőüű", _?LetterQ]      > >     LetterQ::string: String expected at position 1 in > LetterQ[Removed[$$Failure]]. >> >   >     LetterQ::string: String expected at position 1 in > LetterQ[Removed[$$Failure]]. >> >   >     LetterQ::string: String expected at position 1 in > LetterQ[Removed[$$Failure]]. >> >   >     General::stop: Further output of LetterQ::string will be suppressed > during this calculation. >> >   >     {} >   I then tried a `Print` function to see what was going on:               StringCases["áéíóöőüű", _?Print];      > >     á   >     é   >     í   >     ó   >     ö   >     ő   >     ü   >     ű   >   No errors. Then I tried a function that Prints, but returns `True`:               StringCases["áéíóöőüű", _?((Print["(", FullForm@#, ")"]; True) &)]      This produced interleaved lines of characters (expected) and `Removed[$$Failure]` (not expected). I can't include the output properly because of this StackExchange bug.   * What is the cause of this?   * Has it been fixed since version 7?


What does `: Hold[$IterationLimit]` mean?

In this answer, what does the `: Hold[$IterationLimit]` part of the following construct do?               cfRemainders[x_, iter_: Hold[$IterationLimit]]


Creating a Nearest function programmatically

I've been trying to work out how to create a `Nearest` function programmatically. My goal is to produce something similar to this, a hand- assembled function:               nf = Nearest[{0.0 -> "B", 0.05 -> "W", 0.1 -> "H", 0.15 -> "h",          0.2 -> "e", 0.3 -> "c",  0.4 -> "o", 0.5 -> "'", 0.6 -> "-",          0.7 -> ":", 0.8 -> ".", 0.9 -> "-", 0.95 -> " "}];      But instead of making it by hand, and editing the values, I want to pass a string and get all the letters allocated automatically to values between 0 and 1. (This is for producing ASCII-art type versions of images.) For example, a function that looks a bit like this:               makeNearestFunction[string_] :=      nf = Nearest[       Riffle[        Range[0, 1, N[1/StringLength[string]]], Characters[string]]        ...        (* returns a nearest function *)      could be called like this:               nf = makeNearestFunction["Mathematica!:- "]      I've got as far as producing a list of data like this:               {0., "M", 0.0666667, "a", 0.133333, "t", 0.2, "h", 0.266667, "e",       0.333333, "m", 0.4, "a", 0.466667, "t", 0.533333, "i", 0.6, "c",       0.666667, "a", 0.733333, "!", 0.8, ":", 0.866667, "-", 0.933333, " ",       1.}      but the pairs need to be assembled as rules.


Is it possible to extract the rules of cellular automata as Mathematica code?

I would like to run cellular automata in the vertical direction if row index is greater than column index and in the horizontal direction if row index is less than column index, in a square array starting in the upper left corner for some initial value. For this to succeed the cells referred to in the rule must be either on the same row or column or on the two previous row or column. Perhaps not really clearly explained but it is access to the rule description that I would like to have. Example of the type of cross directional table I would like to plot, here in Excel for some cellular automata rule: ![cross directional cellular automata](http://i.stack.imgur.com/6qPyL.png) The cell formula I used was: =IF(OR(AVERAGE(B3;C3;D3)=0;AVERAGE(B3;C3;D3)=4/3;AVERAGE(B3;C3;D3)=5/3; AVERAGE (C2;C3;C4)=0;AVERAGE(C2;C3;C4)=4/3;AVERAGE(C2;C3;C4)=5/3);0;IF(OR(AVERAGE(B3;C3;D3) =1/3;AVERAGE(B3;C3;D3)=3/3;AVERAGE(B3;C3;D3)=6/3; AVERAGE(C2;C3;C4)=1/3;AVERAGE (C2;C3;C4)=3/3;AVERAGE(C2;C3;C4)=6/3);1;2)) which was entered in cell C3 and had the initial matrix: $\left( \begin{array}{cc} 0 & 0 \\\ 0 & 1 \end{array} \right)$ Is there a way to extract or list the rules for cellular automata, in order to write new programs with them to produce images like the one above? * * * Edit: What I am looking for is the source code for cellular automata, with the source code written in Mathematica language. * * * Edit: The program I would like to see work looks like this:               (*program start*)     Clear[n, k, A, nn];     nn = 70     a = {1, 0, 0, 0, 0, 0, 1, 1};     t[n_, k_] :=        t[n, k] =         If[Or[n == 1, k == 1], 0,          If[And[n == 2, k == 2] , 1,           If[Or[And[t[n - 1, k - 2] == 1, t[n - 1, k - 1] == 1,              t[n - 1, k] == 1],             And[t[n - 2, k - 1] == 1, t[n - 1, k - 1] == 1,              t[n, k - 1] == 1]], a[[1]],            If[Or[And[t[n - 1, k - 2] == 1, t[n - 1, k - 1] == 1,               t[n - 1, k] == 0],              And[t[n - 2, k - 1] == 1, t[n - 1, k - 1] == 1,               t[n, k - 1] == 0]], a[[2]],             If[Or[And[t[n - 1, k - 2] == 1, t[n - 1, k - 1] == 0;                t[n - 1, k] == 1],               And[t[n - 2, k - 1] == 1, t[n - 1, k - 1] == 0,                t[n, k - 1] == 1]], a[[3]],              If[Or[And[t[n - 1, k - 2] == 1, t[n - 1, k - 1] == 0,                 t[n - 1, k] == 0],                And[t[n - 2, k - 1] == 1, t[n - 1, k - 1] == 0,                 t[n, k - 1] == 0]], a[[4]],               If[Or[And[t[n - 1, k - 2] == 0, t[n - 1, k - 1] == 1,                  t[n - 1, k] == 1],                 And[t[n - 2, k - 1] == 0, t[n - 1, k - 1] == 1,                  t[n, k - 1] == 1]], a[[5]],                If[Or[And[t[n - 1, k - 2] == 0, t[n - 1, k - 1] == 1,                   t[n - 1, k] == 0],                  And[t[n - 2, k - 1] == 0, t[n - 1, k - 1] == 1,                   t[n, k - 1] == 0]], a[[6]],                 If[Or[And[t[n - 1, k - 2] == 0, t[n - 1, k - 1] == 0,                    t[n - 1, k] == 1],                   And[t[n - 2, k - 1] == 0, t[n - 1, k - 1] == 0,                    t[n, k - 1] == 1]], a[[7]],                  If[Or[And[t[n - 1, k - 2] == 0, t[n - 1, k - 1] == 0,                     t[n - 1, k] == 0],                    And[t[n - 2, k - 1] == 0, t[n - 1, k - 1] == 0,                     t[n, k - 1] == 0]], a[[8]], 0]]]]]]]]]];     MatrixForm[Table[Table[t[n, k], {k, 1, nn}], {n, 1, nn}]]     (*program end*)      The vector "a" is the rule vector for the cellular automata. Here are some example outputs from Excel 2007: http://mobiusfunction.wordpress.com/?attachment_id=1079 http://i.stack.imgur.com/xUnzM.png When I try to run the program I get "recursion limit exceeded" and "iteration limit exceeded" errors. Then I tried to change these session parameters but this gave a program with no output. What to do?


LibraryUnload fails

I can load my library, but I cannot unload it with `LibraryUnload`. I do have a `void WolframLibrary_uninitialize(WolframLibraryData libData)` (which does nothing). I get the following error:               LibraryFunction::unloadlib: The library "/my/library.so" cannot be unloaded.      I am not loading any function after loading the library. The OS is Linux x86_64. I don't seem to be able to unload not even the demo library:               LibraryLoad@"demo"     LibraryUnload@%      This gets me the same error. EDIT: As worked out by Szabolc and halirutan, I need to load one function at least (`LibraryFunctionLoad`) to have the initialization function called, and so being able to call `LibraryUnload` successfully. Yet, my ultimate goal is to be able to reload a new build of the library: this seems impossible because calling `LibraryUnload` doesn't actually close the handle of the library, and further calls to `LibraryFunctionLoad` reuse it. I checked with `lsof`, and if I delete the library and try to reload it I get that the new file is ignored and instead a handle to the old file (tagged correctly as `DEL` in `lsof`) is kept.


Implementing hexagon binning in mathematica

Hexagon bin plots are a useful way of visualising large datasets of bivariate data. Here are a few examples: With bin frequency indicated by grey level... ![enter image description here](http://i.stack.imgur.com/O9lFp.png) ..and by glyph size ![enter image description here](http://i.stack.imgur.com/5okWO.png) There are packages for creating this kind of plot in both "R" and Python. Obviously, the idea is similar to `DensityHistogram` plots. How would one go about generating hexagonal bins in Mathematica? Also, how would one control the size of a `plotmarker` based on the bin frequency? **Update** As a starting point I have tried to create a triangular grid of points:               vert1 = Table[{x, Sqrt[3] y}, {x, 0, 20}, {y, 0, 10}];     vert2 = Table[{1/2 x, Sqrt[3] /2 y}, {x, 1, 41, 2}, {y, 1, 21, 2}];          verttri = Flatten[Join[vert1, vert2], 1];      overlaying some data..               data = RandomReal[{0, 20}, {500, 2}];          ListPlot[{verttri, data}, AspectRatio -> 1]      ![enter image description here](http://i.stack.imgur.com/EOQk0.png) next step might involve using `Nearest`:               nearbin = Nearest[verttri];          ListPlot[nearbin[#] & /@ data, AspectRatio -> 1]      ![enter image description here](http://i.stack.imgur.com/F7GgN.png) This gives the location of vertices with nearby data points. Unfortunately, I can't see how to count those data points..


No real number fitting double exponential in Mathematica

I am trying to fit a double exponential curve to my data, but I got the error saying there are non real number. Also I tried with starting values for my 4 parameters, but this does not work either. I'm doing my tries by modifing this CDF: http://demonstrations.wolfram.com/MeanAndSinglePredictionBandsForANonlinearModel/ And my code and extreme data are these:               Manipulate[      Module[{data, nlm, meanband, singleband, a, b, c, d},            data = {31, 46, 70, 87, 87, 93, 114, 128, 133, 134, 143, 155, 161,          161, 163, 177, 181, 207, 207, 226, 302, 315, 319, 347, 347, 362,          375, 377, 413, 440, 447, 461, 464, 511, 524, 556, 800, 860, 880,          954, 5200, 12000};            nlm = NonlinearModelFit[data,          Exp[-a Exp[-x/b] - c Exp[-x/d]], {{a, 1}, {b, 1}, {c, 1}, {d, 1}},          x];        meanband[x_] = nlm["MeanPredictionBands", ConfidenceLevel -> c1];       singleband[x_] = nlm["SinglePredictionBands", ConfidenceLevel -> c12];            Show[ListPlot[data],          Plot[{Tooltip[nlm[x], "fitted function"],           Tooltip[meanband[x], "mean prediction"],          Tooltip[singleband[x], "single prediction"]}, {x, 1, 15},         Filling -> {2 -> {1}, 3 -> {1}}], PlotRange -> {0, 15000},         ImageSize -> 500]],      {{c1, 0.95, "mean prediction level"}, .5, .995, 0.005},      {{c12, 0.95, "single prediction level"}, .5, .995, 0.005},       ControlPlacement -> Top]      What could I do to fix this error? ![enter image description here](http://i.stack.imgur.com/fZoY6.jpg)


Partial result of aborted evaluation of FullSimplify

When `FullSimplify` invoked on a large expression, it can run for hours. If I do not have time to wait, and abort the evaluation, I get no result, although, conceivably, some forms simpler than the initial argument have been found already. Is it possible to create a version of `FullSimplify` that can display the simplest form found so far in a temporary cell, and return it if the evaluation is aborted?


All possible topological orderings of a graph

`TopologicalSort[]` returns one of many unique orderings. > From wikipedia: > > if a topological sort does not form a Hamiltonian path, the DAG will have > two or more valid topological orderings, for in this case it is always > possible to form a second valid ordering by swapping two consecutive > vertices that are not connected by an edge to each other. It should be simple, but how do you know how many possible orderings there are? Also, grouping and swapping feels kind of awkward, whats the preferred method?


How can one nested list be used to find the positions of those values in another nested list?

lista = {{0., 1., 0.1, 0.}, {0., 1., 0.2, 0.}, {0., 1., 0.3, 0.}};          listb = {       {0., 1., 1., 0.}, {0., 0.85, 1., 0.}, {0., 1., 0.1, 0.},        {0.,1., 0.2, 0.}, {0., 1., 0.3, 0.}, {0., 1., 0.4, 0.},        {0., 1., 0.55, 0.}, {0., 1., 0.7, 0.}, {0., 1., 0.85, 0.},        {0.4, 0.4, 0.2, 0.1}, {0.4, 0.4, 0.4, 0.1}, {0.4, 0.4, 0.7, 0.1},        {0.4, 0.7, 0., 0.1}, {0.4, 0.7, 0.1, 0.1}, {0.4, 0.7, 0.2, 0.1},        {0.4, 0.7, 0.4, 0.1}, {0.4, 0.7, 0.7, 0.1}, {0.5, 0.4, 0.4, 0.},        {1., 0., 0., 0.1}, {0., 1., 0., 0.1}, {0., 0., 1., 0.1},        {0.,1., 1., 0.1}, {1., 0., 1., 0.1}, {1., 1., 0., 0.1}};      How would one go about finding the first positions of `lista` sublists in `listb`?


Stream CSV files

Ram limitations make import impractical for large CSV files. Is it possible to Stream CSV correctly?               str = OpenRead["EU.csv"]     Read[str, "CSV"] #=> Read::readn: "Invalid real number found when reading from \!\(\"EU.csv\"\)."     Read@str #=> Read::readt: "Invalid input found when reading \!\(\"lTid,cDealable,CurrencyPair,RateDateTime,RateBid,RateAsk\\\\n\"\) from \!\(\"EU.csv\"\)"     Close@str      Here's the CSV file. Though I think it's properly formatted.


Change sublist based on position

Supposed that:               list = {2, 3, 5, 7, 9};     sublist = {{3, 3, 5}, {2, 2, 2, 7, 9}};      I want to change each sublist in sublist as following:   1. Find the positions of elements in sublist in list.So, > >     {3, 3, 5} -> {2, 2, 3} and {2, 2, 2, 7, 9} -> {1, 1, 1, 4, 5}. >                 sublist1 = {{2 ,2, 3}, {1, 1, 1, 4, 5}};      2,Change each sublist in sublist1 to sparsearray: > >     {2, 2, 3} -> {0, 2, 1, 0, 0} and {1, 1, 1, 4, 5} -> {3, 0, 0, 1, 1}. >                 sublist2 = {{0, 2, 1, 0, 0}, {3, 0, 0, 1, 1}};      How to do it?


Replace For-loop with functional code

I am very new to _Mathematica_. I have code written using for loops. I want to rewrite it using `Map`/`Thread` but I am not sure how to do it. My code takes the set `A`, say               A = {{1, 2, 3, 1, 2, 3}, {1, 1, 2, 2, 3, 3}}      Then it insert a arbitrary character(say $a$) to every possible positions of given element in the set `A`. So we get > >     {{a, 1, 2, 3, 1, 2, 3}, {1, a, 2, 3, 1, 2, 3}, ..., >      {a, 1, 1, 2, 2, 3, 3}, ..., {1, 1, 2, 2, 3, 3, a}} >   Then it inserts the same character again into resulting elements in following manner > >     {{a, a, 1, 2, 3, 1, 2, 3}, {a, 1, a, 2, 3, 1, 2, 3}, >      {a, 1, 2, a, 3, 1, 2, 3}, ...., {1, 1 , 2, 2, 3, 3, a}} >   This question come from Knot Theory-Chord Diagram My program using for loops is follows.               A = {{1, 2, 3, 1, 2, 3}, {1, 1, 2, 2, 3, 3}};     kk = Length[A[[1]]]/2 + 1;          B = {};          For[m = 1, m < Length[A] + 1, m++,       Diag1 = A[[m]];       For[j = 1, j < (2*kk), j++,         Diag2 = Insert[Diag1, "a", j];          For[i = 1 + j, i < (2*kk) + 1, i++,           Diag3 = Insert[Diag2, "a", i];           B = AppendTo[B, Diag3];         ];       ];     ];      This is what I tried to do with element 2.               f[x_] := Insert[A[[2]], "a", x];     B = Map[f, Range[7]]];      But I don't know how to put variable `A[[i]]` instead of `A[[2]]` and also how to insert other end of $a$ to this result using map. Any comment really appreciated.


Making a Logplot with errorbars

I have some data points with corresponding error bars. I would like to plot these together with another graph. This other graph is plotted as a LogLinearPlot. I tried plotting the data points by using "ErrorListPlot" and then merging this plot with the other plot, but the data points get all messed up. Is there any easy way to resolve this problem?


How can I replace the general element of a geometric series with the sum of the series?

Consider the list               mylist = {b(a/bc t)^r, a/b(b t)^r, a (c/d t)^r, ...}      where a, b, c, t, etc., are real numbers between 0 and 1. I want to sum each term in the list over r from 1 to infinity. Since my list is very long, _Mathematica_ takes a long time if I evaluate               Table[Sum[mylist[[k]], {r, 1, ∞}], {k, Length[mylist]}]      Instead, I would like to write a function which I can apply to the list such that for each element, `x^r -> x/(1-x)`? I think this would be a lot faster than _Mathematica_ computing a geometric series for each element.


No response to an infinite limit

Trying to compute this limit, things seem to get frozen, even for hours. What would you   recommend to fastly compute it?               Limit[(Integrate[Product[x^k (1 - x^k), {k, 1, n}], {x, 0, 1}])^(1/n),n -> Infinity]


Piecewise conditions with a parametric PDE

I'm using ParametricNDsolve to check best fit of a model (function Eb1) with some data, and I have four free parameters I want to test. I can easily construct a Parametric solution between the two boundaries of interest $r_{n}$ and $r_{o}$ - however, I also need to define the function between $0 \leq r \leq r_{n}$; in this case it's a constant whose value is given by Eb1($r_{n}$) , so that for $r \leq r_{n}$ the value is constant. I can do this with Piecewise when I manually specify the parameters (kme, kmn, j, eo) but I am running into errors using Piecewise with a parametric function; my code so far is;               (*Constants required*)     a = 8.2314*10^-7; omega = 3.0318*10^7; Do2 = 2*10^-9; po = 106; ro = 235*10^-6; micron = 1*10^-6; qm = 10^-4; mic = 1*10^-6; De = 5.5*10^-11;  con = (a*omega)/(6*Do2); rl = Sqrt[(6*Do2*po)/(omega*a)];          (*Functions that are pre-defined*)      rn = Piecewise[{{0, ro <=  rl}, {ro*(0.5 - Cos[(ArcCos[1 - (2*rl*rl)/(ro^2)] - 2*Pi)/3]), ro  > rl}}];          p[r_] = Piecewise[{{po + con*(r^2 - ro^2 + 2*(rn^3)*(1/r - 1/ro)), r > rn} , {0 , r <= rn}}];          q[r_] = qm*((kme/(kme + p[r]))*(p[r]/(kmn + p[r]))  + (kmn/(kmn + p[r]))*j);               (*Coupled Equations to be solved*)       eqnDe = D[Ef1[r, t], t] -  De*(D[Ef1[r, t], r, r] + (2/r)*(D[Ef1[r, t], r])) + q[r]*Ef1[r, t];          eqnBo = D[Eb1[r, t], t] - (Ef1[r, t])*q[r];               (*Parametric solution for unknowns kme, kmn, j and eo*)     x = ParametricNDSolve[{eqnBo == 0, Eb1[r, 0] == 0, eqnDe == 0,      Ef1[r, 0] == 0, Derivative[1, 0][Ef1][rn, t] == 0,      Ef1[ro, t] == eo},  Eb1, {r, rn, ro}, {t, 0, 14400}, {kme, kmn, j, eo}];      So far so good; now to define the full range of Eb1, including the domain $r < r_n$, I try to use Piecewise;               Ebound[r_] =        Piecewise[{{Eb1[rn, 14400] /. x, r < rn}, {Eb1[r, 14400] /. x,       r >= rn}}];      but this yields the error _ParametricNDSolve::fpct: "Too many parameters in {kme,kmn,j,eo} to be filled from {r,14400}."_ \- Similar error messages occur when I try Ebound[r_,kme_,kmn_,j_,eo_] - is there anyway I can define this chunk of the domain with the parametric solution? I'll meet to do this before I try fitting to the data and I have and this is proving a stumbling block!


Solving recurrence relationship using iteration

I am trying to create a _Mathematica_ function that basically splits up a continuous function (in this case a physical potential) into steps (strips as it were) and returns the value of the function at that step (i.e., the potential at respective strip boundary). This is used to calculate a transmission coefficient (it's just some function) at every point in that potential. I have tried to use the in-built function `RecurrenceTable`, but did not work out (i.e. I get a relation but it's wrong and gives me errors.). I have not fully quit on it, but it would take me too long to explain the inner workings. Either way, my recurrence relation for some `Z` is:               Zinput[i] ==  Z0[i]*((Zinput[i + 1] Cosh[k[i] l]) - (Z0[i] Sinh[k[i] l])) /      ((Z0[i] Cosh[k[i] l]) - (Zinput[i + 1] Sinh[k[i] l]))        I want to plug this into a `Do` or `For` loop so that each value depends on the previous one. This should be easy to achieve, but I have no idea how to set the function to do this. * * * Just for clarification, the dependence on `i` is defined as follows:               k[i_] := (Sqrt[2. m (V[i] - En)]/hbar);     Z0[i_] := (- I h  k[i])/m     V[i_] := potential[( i/100.)];     potential[x_] :=  Piecewise[{{((V0/2. )*(Cos[(2. Pi / λ) (x - λ/2)] + 1)),        0 <= x <= M λ}}];      Where `h`, `V0`, `λ`, and `M` are constants defined by me (basically they scale the potential). I have attempted to use the nest list function               b[c_] := NestList[Z0[i]*((Zinput[i + 1]Cosh[k[i]l])-(Z0[i]Sinh[k[i]l]))/       ((Z0[i] Cosh[k[i] l]) - (Zinput[i + 1] Sinh[k[i] l])), Zinput[i], c]      However, this does not give me something I can plot. I am trying to apply the formula for `Zinput` (the big long $\sinh$ and $\cosh$ thing) to be the next input while `Z0` is the initial value to start with. I also should've mentioned the splitting of the potential is done from right to left (and this is something I cannot change).


Mathematica equation tagging

> **Possible Duplicate:**   >  How do I get the equivalent of the $\LaTeX$ \tag{} in Mathematica? This seems like an obvious question yet I cannot find any answer to it. I am using Mathematica 8 and am sequentially numbering my equations using (Format->Style->DisplayFormulaNumbered). This works fine but how can I reference specific equations in text so that they will change accordingly if I add new equations before the referenced equation? I know LaTeX does this fantastically and it seems like an easy process. Just to be specific, If I have equations, blah=blahblah (1) nerg=flarg (2) plugging in equation (2) into equation (1)... but then I want to add an equation before equation (1), how can I automatically have the text change to "plugging in equation (3) into equation (2)..."? Also, is there anyway to have more control over the numbering? Such as instead of equation (2) can I have equation (2.1)? This would help since I have sections that would make that numbering style much nicer. Thanks! I hope this is not a frequently asked question but I searched and couldn't find an answer.


Speed of curated data calls in Version 10

Curated datasets underwent a significant overhaul in version 10, primarily in the way content is delivered in the form of Objects and Entities. Additionally, it appears that this change in content delivery has also brought about a considerable decrease in performance. Consider the following:               ChemicalData[All, "Preload"]     MapThread[ElementData[#1, #2] &, Transpose@         Tuples@{Range@112, {"Symbol", "Group"}}]; // AbsoluteTiming     MapThread[ElementData[#1, #2] &, Transpose@         Tuples@{Range@112, {"Symbol", "DiscoveryYear"}}]; // AbsoluteTiming      The results from my system (Windows 7 64 bit) are {0.24, 0.16} seconds for version 10 and {0.04, 0.02} for version 9. My original hypothesis was the `Head` change in v10; however that does not seem to be the case since:               Head /@ Flatten@Outer[ElementData, {1},          {"Symbol", "Group", "DiscoveryYear"}]      yields `{String, Integer, DateObject}` in v10 and `{String, Integer, Integer}` in v9; if the change in Head was the cause, we wouldn't expect slowdowns in both of the calls above. The performance difference really shines in this next example:               out = ChemicalData["Hydrocarbons"];     If[$VersionNumber == 10.,         QuantityMagnitude /@ Through[out[[30 ;; 40]]["BoilingPoint"]],         Outer[ChemicalData, out[[30 ;; 40]], {"BoilingPoint"}] // Flatten] // AbsoluteTiming      I may be comparing apples to oranges here, but I couldn't come up with a single command that would handle the different Head types that are returned in v9 and v10; I'm assuming `Through` and `Outer` are similarly fast. In any case, they certainly couldn't account for the difference in timing; **I get 6.44 seconds for v10 and 0.002 for v9.** Most of the bottleneck in this last example is due to my horrendously slow internet speed; however, it seems preloading the curated data, as suggested here apparently no longer applies in v10. If I turn the internet off with               $AllowInternet = False      The `ChemicalData` example returns errors in v10 and is unaffected in v9. Apparently, `EntityValue`s used in v10 require an internet connection. So from this information one can conclude that _internet connectivity is one part of the performance issue in v10 curated data calls_ and leads to the question: **How do we access curated data off line with v10?** The data have been stored on my computer, I see them in `"Location"/.PacletInformation["ElementData"]`, but something else that is occurring while processing these data requires the internet, and I'm at a loss as to how one debugs this issue further. Internet connectivity is only part of the solution; however, since the `ElementData` example is unaffected by `$AllowInternet = False` in both v9 and v10. The second part of the question is then: **what is v10 doing to make a no-internet-required curated data call 10 times slower than in v9?**


Algebraic condition from a non linear equation

I have got a system of equations which look like this: $\theta_{1}^{2}e^{\phi_{1}\cos(\Omega z)}\tilde{w}\cos^{2}(\theta_{1}\sin\Omega z)\sin^{2}\Omega z+\frac{1-\lambda\cos(2\theta_{1}\sin\Omega z)}{1+be^{-\phi_{0}}e^{-\phi_{1}\cos(\Omega z)}\sin^{2}(2\theta_{1}\sin\Omega z)}=0$ and similarly for the other one. I don't want to solve this equations in $z$, but just treat them as algebraic equations to extract some conditions on $\theta_1, \phi_1$. This means, I want to check under what conditions on the constants, this equations have a solution. By hand, what I would do is to write down the series expansion of all the $\sin(\sin\Omega z)$-like terms, and then integrate over 0 to $\pi$ to make some terms vanish. But since here the expressions are horrible, I was wondering if Mathematica could help me getting the conditions or at least some insight in this kind of problems. This is a much more general class of equations or at least common calculations Physics people are usually interested in, and could be useful for a lot of different scopes apart from my toy problem.


Apply function to every element of list regardless of depth

I want to apply a function to every element of a list without taking braces into account (depth level), but with the same form of output. Here is an example :               {a,b,{c,d},{{e}}} -> {f[a],f[b],{f[c],f[d]},{{f[e]}}}      It would be the same as applying the function to `Flatten[data]`, but keeping the depth as is. Let me know if I am not precise enough.


Plot3D with a log scale only along the y-axis

I would like to ask how to make a 3D plot (maybe using Plot3D) with a logarithmic scale along the y-axis? For example: I have a function, $f(x) = 2(1 + a\,x^4)/x^2$, where $x$ varies from 0 to 20 while $a$ varies from 0 to $10^{-3}$. I am interested in making a 3D plot of $f(x)$ in a low range of $a$ such as from 0 to $10^{-7}$ or 0 to $10^{-5}$. Therefore, I think it might be better to scale the y-axis logarithmically. Any suggestion would be highly appreciated.


Using the elements of a subset in a Do loop

I would like to use the elements of `Subsets` in a `Do` loop. I have:               w = Subsets[{3, 4, 5, 6}, {2}]      which yields: > {{3, 4}, {3, 5}, {3, 6}, {4, 5}, {4, 6}, {5, 6}} Now I want to use these ordered pairs in a `Do` loop. For example:               Do[ma[i]+mb[j],{i,...},{j,...}]      where `{i,j}` should be only these ordered pairs.


Function given exact arguments returns hugely different value than it returns when given equivalent inexact arguments

I was trying to compute the probability that a coin is from a particular underlying distribution given that a particular set of tosses was observed. (I know this can be done in a different way, but I was just thinking of using Bayes in this context.) I wrote this function:               PPP[heads_, total_, a_, b_] :=       (Integrate[p^heads (1 - p)^(total - heads), {p, a, b},          Assumptions -> {0 < a, a < b, b < 1, 0 <= heads, heads <= total}]) /         (Integrate[p^heads (1 - p)^(total - heads), {p, 0, 1},             Assumptions -> {0 <= heads, heads <= total}])      When I evaluate               N[PPP[1000, 2000, 495/1000, 505/1000]]      I get > >     0.345408, >   which seems reasonable. (The probability that your coin's distribution is between 0.495 and 0.505 given that you've witnessed 1000 heads in 2000 tosses is 0.345408.) but, if I do               PPP[1000, 2000, 0.495, 0.505]      I get > >     3.936310242253867*10^468. >   This makes no sense just on the face of it. The integral at the top is a _subset_ of the integral at the bottom, and the integrand is strictly positive, so there's no way the numerator can be greater than the denominator. Why is this happening? (I'm using _Mathematica_ 9.0.0). Here's the notebook with those equations, if you don't want to cut and paste: ppp.nb.


Adding/deleting weighted edges to a weighted graph

**How can I add and delete weighted edges in a weighted graph?** Using `Graph` in _Mathematica_ I want to add a weighted edge to a weighted graph. The problem is `EdgeAdd` seems to always return an unweighted graph. For example:               g = Graph[{1 \[UndirectedEdge] 2, 2 \[UndirectedEdge] 3}, EdgeWeight -> {5, 11}]     g1 = EdgeDelete[g, 2 \[UndirectedEdge] 3]     g2 = EdgeAdd[g, 1 \[UndirectedEdge] 3]      Here, `g1` has its edge weights messed up, so `WeightedAdjacencyMatrix` does not work. It seems the list of edge weights is too long since no element has been deleted. `g2`, on the other hand, is an unweighted graph. I even tried wrapping the added edge in               Property[1 \[UndirectedEdge] 3, EdgeWeight -> 13]      but that only got me an error when supplied to `EdgeAdd`. I can bypass the `EdgeDelete` thing quite easily by afterwards readjusting the `EdgeWeights` list, but I haven't found a way to solve the `EdgeAdd` problem.


How do I check if any element in a list is positive?

As a simple example of what I would like to do, suppose I have a list `a` of all real numbers. I would like to perform a simple check to see if _some_ element of `a` is positive. Of course, I could do this with a simple loop, but I feel as if _Mathematica_ would have a more efficient way of doing this, in the spirit of functional programming. Is there, or do I just have to do this with a clumsy loop:               test=False; For[counter=1;counter<=Length[a];counter++;If[a[[counter]]>0,test=True;];];


Alleviating a bottleneck involving a function call with symbolic derivatives

I have a bottleneck problem involving a function call with symbolic derivatives. I don't have much experience with _Mathematica_ (or any dynamic language) and I'm certain that the way I've set this up is about as basic as it gets, so anyone _Mathematica_ -fluent will probably spot several "obvious" changes that should speed things up. Please tell me what these are! There are probably a host of RTFM suggestions for speeding up calls to this function (which I welcome) but specific suggestions would be great too. The quantity `mainTerm[l, m, r, Theta, Phi, FactorA, FactorB]` gets called **many** times in a nested loop of (r,Theta,Phi) coordinates and (l,m) iterations; so this involves calling spherical harmonics/Hankel functions (and calculating their derivatives and double derivatives) ad nauseum. When I expanded out the derivatives/double derivatives down to the level of hypergeometric basis functions (to avoid doing calculus on the fly), this seemed to slow things down, which has me baffled. The block shown below is mainly to illustrate the complexity of the function I need to compute (i.e., I'm hoping for advice on how to compile or otherwise speed up functions when analytic derivatives might need to be calculated on the fly, not quantitative `// AbsoluteTiming` comparisons):               k = somevalue;          preAAA := FactorA*(SphericalHankelH1[l, k*r]*                  D[D[SphericalHarmonicY[l,m,Theta,Phi],Theta]*Sin[Theta],Theta] +                   SphericalHankelH1[l, k*r]*D[D[SphericalHarmonicY[l,m,Theta,Phi],Phi]]);          AAA := Expand[preRadial];          BBB := (FactorB*SphericalHankelH1[l, k*r])*D[SphericalHarmonicY[l,m,Theta,Phi],Phi] -                 FactorA*D[SphericalHarmonicY[l,m,Theta,Phi],Theta]*                D[r*SphericalHankelH1[l, k*r],r];          CCC := (FactorB*SphericalHankelH1[l, k*r])*D[SphericalHarmonicY[l,m,Theta,Phi],Theta] -                 FactorA*D[SphericalHarmonicY[l,m,Theta,Phi],Phi]*                D[r*SphericalHankelH1[l, k*r],r];          mainTerm[l_,m_,r_,Theta_,Phi_,FactorA_,FactorB_] = AAA + BBB + CCC;      Subequently, inside the (l, m) loop I set `storeValue[[l, m]] = mainTerm[l, m, ...]`. When I compile `AAA`, `BBB` and `CCC` individually and set `storeValue` this way, the code runs **slower** (which I am confused about). I'm aware that compiling my component terms **could** (should?) speed things up, and I've tried various approaches to that end (with/without compiling to C, with/without explicitly defining `Reals` and `Integers`, etc.) but none of them had much effect and some slowed things down. Any suggestions on how better to set this up for a large number of nested function calls?


Export with different address

Is it possible to use the `Export[]` command and add another address other than the usual `Home` directory that is used?


Are there built in functions to perform a geometric transform to rotate a set of points around an arbitrary point?

I have a list of points `{{4,5},{6,7},{9,8},...}` in two-dimensions. I'd like to rotate these points some number of degrees $\theta$ around an arbitrary anchor point in a two-dimensional plane, and recover the transformed point list. Is there a straightforward way to do this? How about for three- dimensional rotations around an arbitrary point?


J/Link: InstallJava[..] or ReinstallJava[..] hangs when used with a link to a remote jvm running Install.main

While I am able to use `InstallJava[]` (or `ReinstallJava[]` for that matter) with a TCP/IP link to a JVM running on the same system just fine (as shown on page 110 of the jlink user guide, e.g. for debugging purposes), I am not able, however, to get `InstallJava[]` working with a TCP/IP link connecting to a JVM running on a remote system. When I try to have `InstallJava[]` connect to the remote JVM, the link itself seems to connect fine (because when I kill the _Mathematica_ process, the remote JVM exits as expected), but `InstallJava[]` never returns and cannot be interrupted/aborted. (Tried this with links from Linux 64 ( _Mathematica_ ) to Windows 64 (jvm) and Linux 64 to Linux 64. Used JVMs installed with Mathematica and others. No problems with underlying link communications, remote or local. Just `InstallJava[]` hangs exclusively with remote JVMs.) Questions:   1. Is this not supported?   2. If it is supported, how to troubleshoot? Thank you!


Control which variables get embedded inside Manipulate

While trying to analyse several different datasets I got what I thought was a good idea: define a "function" that returns a `Manipulate` object. But this has some problems when larger amounts of data are passed to `Manipulate`. When the code is first run there is long delay before the manipulate pane is displayed, because the the data gets embedded inside `"Body"` of `Manipulate`. Here is a code snippet that illustrates the problem:               (*Generate some data*)     data = RandomVariate[BinormalDistribution[Abs@Random[]], {5, 10^4}];     histograms = DensityHistogram[#, 30, PerformanceGoal -> "Speed"] & /@ data;     images = Rasterize[#, ImageSize -> Medium] & /@ histograms;          AnalysePlots[plots_] :=        Manipulate[plots[[i]], {i, 1, Length[plots], 1}];          (*Now compare:*)     t = AbsoluteTime[];     AnalysePlots[images] // AbsoluteTiming     AbsoluteTime[] - t     (* ==>3.7091792<---HERE IMAGES GET EMBEDDED*)          t = AbsoluteTime[];     Manipulate[images[[i]], {i, 1, Length[images], 1}] // AbsoluteTiming     AbsoluteTime[] - t          (* ==>0.0312500<---Here they don't*)      **Can I somehow choose whether to embed the data (in this case the variable plots) into`Manipulate`?** When developing the function `AnalysePlots` it would be nice if I could do something like:               AnalysePlots[images, "Embed"->False]      which would have the benefit of displaying quickly. Then when I've finished `AnalyzePlots` I would deploy it with:               AnalysePlots[images, "Embed"->True]      which I could then copy and paste to a new notebook, deploy to CDF etc... (I've already tried `SaveDefinitions->False` and `UnsavedVariables :> {plots}`)


Speed up DensityHistogram rendering (display)

When I tried to present some pre-calculated density histograms inside Manipulate I noticed that the display of `DensityHistogram` is extremely slow. Here is a simple benchmark:               Second[x_] := x[[2]];     data = RandomVariate[BinormalDistribution[Abs@Random[]], {5, 10^4}];     histograms =        DensityHistogram[#, 30, PerformanceGoal -> "Speed"] & /@         data;     contourplots =        ListContourPlot[Second@HistogramList[#, 30],           InterpolationOrder -> 0] & /@ data;     rasterizedSmall = Rasterize[#, ImageSize -> Small] & /@ histograms;     rasterizedMedium = Rasterize[#, ImageSize -> Medium] & /@ histograms;          t = AbsoluteTime[];     histograms     AbsoluteTime[] - t     (* ==> 1.6410939 *)              t = AbsoluteTime[];     contourplots     AbsoluteTime[] - t     (* ==> 0.0860049 *)          t = AbsoluteTime[];     rasterizedSmall     AbsoluteTime[] - t     (* ==> 0.0390022 *)              t = AbsoluteTime[];     rasterizedMedium     AbsoluteTime[] - t     (* ==> 0.0280016 *)          So we see that it takes almost two seconds to display five pre-calculated density histograms, while five list contour plots are displayed in ~100 ms. **What is wrong and is there an easy way to fix it?** (I'm using mma 8.0.1 on Win 7 and I've already turned off antialising)


LocatorPane, Dynamic and deleting locators

Compare the following two code snippets : Version 1                 pts = {{1, 1}, {0.2, 0.3}, {0.5, .3}}       locpts = pts;       Panel[        LocatorPane[         Dynamic[locpts,          {(locpts = #; pts = #             ) &}],         Dynamic@          Graphics[{Point[locpts], Dynamic[Polygon[locpts]]},             PlotRange -> {{0, 1}, {0, 1}}],         LocatorAutoCreate -> All]]      Version 2                 pts = {{1, 1}, {0.2, 0.3}, {0.5, .3}}       locpts = pts;       Panel[        LocatorPane[         Dynamic[locpts,          {(locpts = #; pts = #             ) &}],             Dynamic@          Graphics[{Point[locpts], Dynamic[Polygon[pts]]},            PlotRange -> {{0, 1}, {0, 1}}],         LocatorAutoCreate -> All]]      Both versions are the same except for the third line from below where `Polygon[locpts]` was changed to `Polygon[pts]`. In the first version a delete of a locator is immediately propagated in the graphic while this is not the case in the second version. I would expect no difference since I set both `pts` and `locpts` to `#`. **Question: what is the explanation of this behavior?**


How do I find the most populous cities in the world?

I am attempting to plot the most populous cities on a world map. Currently, I have the line of code:               numberofpeople =        Map[{#, Length[CityData[#, "Population"]]} &, CityData[All]];      which should give me the City name, and the population. However, when I type in the line of code               Reverse[SortBy[numberofpeople, Last]][[1 ;; 20]]      I am getting odd data, which is that the most populous cities have 1 person. Could somebody debug my code, and answer any future questions I have on the matter? Much appreciated. EDIT: How do I plot these points on a World Map? Currently I have Graphics[{EdgeForm[Black], , CountryData[#, "SchematicPolygon"]} & /@ CountryData[]] but I have no idea what goes between the points.


How to Combine Pattern Constraints and Default Values for Function Arguments

**EDIT:** _As several respondents have noted in the answers and comments below, the original example had a default value that would never be used because of the way patterns and default values are applied. I've edited the example so that it now focuses on the question that was being asked and which has already been answered._ Is it possible to achieve the following behavior in a function definition:               Remove[foo];     foo[Optional[Pattern[x, _?IntegerQ], 1]] := x;     foo[]     foo[2]          1     2      using "colon syntax" shorthand? Note that,               Remove[foo];     foo[x : _?IntegerQ : 1] := x;     foo[]      foo[2]           foo[]     foo[2]      does not produce the desired result. The first code sample is too verbose; setting a default value for a function argument while simultaneously checking type when an argument is supplied should be common enough practice to deserve its own shorthand notation. Can anyone modify the second example to achieve the desired results? If Mathematica syntax does not directly support shorthand for combining default values with argument type checking, perhaps someone could suggest how this might be achieved using the Notation package.


Is it possible to use PatternTest and Optional value on one Pattern simultaneously?

> **Possible Duplicate:**   >  How to Combine Pattern Constraints and Default Values for Function > Arguments First a simple example: define a function "add" with two arguments, and its second argument should be Positive and have a default value 1.               addv1[x_, (y_:1)?Positive] := x + y;     addv2[x_,y?Positive:1] := x + y;      these two just don't work as expected. So is it impossible to use `PatternTest` and `Optional` value on one `Pattern` simultaneously, considering the probability of its default value conflicting with its pattern test?


Reduce distances between vertices of graph to minimum possible?

This simple graph has vertex shapes of different sizes:               edges = {1 \[DirectedEdge] 2, 2 \[DirectedEdge] 3, 3 \[DirectedEdge] 1};     vsf[{xc_, yc_}, name_, {w_, h_}] :=       Module[{},        Switch[name,         1, size = 0.1,         2, size = 0.2,         3, size = 0.3];        Disk[{xc, yc}, size]        ];     Graph[edges, VertexShapeFunction -> vsf, VertexLabels -> edges]      ![graph 1](http://i.stack.imgur.com/IeAUE.png) So now I want to reduce the distance between the vertices according to the size of the shapes: ![graph 2](http://i.stack.imgur.com/2NVEw.png) It's like the edges are elastic. Perhaps there's some kind of layout option that does this that I can't find, or some way of allowing the edges to be controlled by the vertex shape function? I'm struggling with Mathematica 8 graphing a bit, to be honest (is it just me, or is the documentation not up to the usual standards?) so I don't know whether this is possible, difficult, or easy... I'm hoping to be able to use graph/network tools to produce images like this (see the interactive version here: ![londonworldmap](http://i.stack.imgur.com/rF97n.png) and also apply a similar technique to other ideas, such as this graph for the US 2012 election: ![us election](http://i.stack.imgur.com/gZlIn.png)


How to find solutions that yield of root of unity?

I have a polynomial with coefficients that are integer polynomials in another (complex) variable. For example:               1 + (1 - v^2) #1 + (-3 - v^2) #1^2 + #1^3 &      I want to solve for $v$ such that the second root of this polynomial is a root of unity. Notice that $v=0$ is such a solution:               In[67]:= Root[1 + (1 - v^2) #1 + (-3 - v^2) #1^2 + #1^3 &, 2] /. {v -> 0}     Out[67]= 1      My two attempts to pull this information out of Mathematica have not worked. Namely,               In[68]:= Reduce[RootOfUnityQ[Root[1 + (1 - v^2) #1 + (-3 - v^2) #1^2 + #1^3 &, 2]], {v}]     Out[68]= False      and               In[66]:= Solve[RootOfUnityQ[Root[1 + (1 - v^2) #1 + (-3 - v^2) #1^2 + #1^3 &, 2]], {v}]     Out[66]= {}      both say that there are no solutions, which is not the answer that I am looking for. # Question: How do I solve for $v$ such that some expression is a root of unity?


How do I make my discrete plot thicker?

I am making a discrete plot and a regular function plot together. But my curve is so thick that for color-blind people, it's pretty much impossible to see the black dots of my discrete plot:               plot1 = ParametricPlot[{Sin[t], Cos[ t]}, {t, 0, 2 Pi},         PlotStyle -> {Red, Thickness[0.01]}];          plot2 = ListPlot[Table[{Sin[n], Cos[n]}, {n, 50}],         PlotRange -> {-1, 1}];          Show[plot1, plot2]      > ![combined plot](http://i.stack.imgur.com/1XF6m.jpg) I tried adding "thickness" parameter, but it didn't work.


Help to solve Simultaneous Equations

I think this should be easy to numerically solve in Mathematica, but for some reason I'm not finding the correct way to do it. I basically want to solve these simyltaneous equiations:               NSolve[     {     -(0.7)*w + (0.3)*y + (0.4)*z == 0,     -(0.6)*x + (0.2)*y + (0.1)*z == 0,     (0.5)*w + (0.3)*x - y == 0,     (0.2)*w + (0.3)*x + (0.5)*y - (0.5)*z == 0,                                \     w + x + y + z == 1     },      {z , w , x , y}]      This is what i see: ![image](http://i.stack.imgur.com/qXG0G.png)


NSum generates a warning message when getting the sum of a list

I know what I'm doing can be done with `Total`:               a = Range@3;     Total@a      And if I simply choose `Sum`, nothing wrong will happen:               a = Range@3;     Sum[a[[i]], {i, 3}]      `N@Sum` is still OK:               a = Range@3;     N@Sum[a[[i]], {i, 3}]      But when it's changed to `NSum`, a warning message comes out though I still get the correct result:               a = Range@3;     NSum[a[[i]], {i, 3}]      > Part::pspec: Part specification i is neither an integer nor a list of > integers. I found if I add a `Hold`, I can avoid the warning:               a = Range@3;     NSum[Hold@a[[i]], {i, 3}]      But I still want to know the exact reason.


stationary distribution of a transition matrix

How can I solve the stationary distribution of a finite Markov Chain? In other words, how can I estimate the eigenvectors of a transition matrix?


Creating diagrams for category theory

Lately I've been doing algebra and I have found myself drawing a bunch of diagrams when I attempt to solve a problem. Most of the diagrams are very simple so I thought, I bet I can do this in _Mathematica_ and include these pictures in a nice document. What I would like to do is create diagrams like the ones found in category theory: ![img1](http://i.stack.imgur.com/tPUJa.png) ![img2](http://i.stack.imgur.com/vSYNi.png) Here is an attempt based on a solution provided by Mr.Wizard               vertex = {         {White, Disk[#2, 0.04]},         Text[#, #2]         } &;     GraphPlot[{        {"A" -> "B", "f"},        {"A" -> "C", "h"},        {"B" -> "C", "g"}        },       DirectedEdges -> True,       VertexLabeling -> True       ] /. {Text -> vertex, Framed -> (# &)}      ![img3](http://i.stack.imgur.com/MeJJ0.png) I like the idea of how in `GraphPlot` you can define the vertices and the labels. Unfortunately I'm still not very savvy on controlling many aspects of the `Graphics`. Does anyone know how to create diagrams like the ones I'm attempting to draw? It would be awesome if the font size could be specified. ## Edit: As belisarius pointed out: > Text length and font size should be considered with care As requested by Mr.Wizard, here is are some interesting diagrams: http://scientopia.org/blogs/goodmath/category/good-math/category-theory/ ![imglink1](http://scientopia.org/img-archive/goodmath/img_11.jpg) ![imglink2](http://pdp7.org/blog/wp-content/uploads/2011/01/Screen- shot-2011-01-24-at-16.11.06-.png) The second picture can be found here A quick search on google images for "category theory diagrams" will give you some other diagrams including the ones I have put in here. It seems based on the figures that most of them involve simple rectangles with diagonal lines. In some cases some lines might be curved but this can all be done with straight lines. Since the arrangement of the lines is up to personal choice it would be good to have a solution in which we can move the vertices locations, a similar functionality should be done with the edge labels. I picture an edge label as an image that can rotate around a point in a line. That way we can select a position in the line and the position angle. In most cases this angle is multiples of 45 degrees.


Checkbox Matrix

Is it possible to create a dynamically changing binary $n \times n$ matrix $A$, which appears to the user as a $n \times n$ matrix/table of checkboxes and the user can change the entries of $A$ by checking or unchecking these checkboxes? If yes, what would be the easiest way?


Building sparse array from packed arrays

Suppose I have two _large_ packed arrays `a` and `b`, that respectively contain the position of the elements of a _square_ matrix (i.e. `a` has the explicit form {{1,2},{2,3},{3,4},...}) and the value for each matrix element (i.e. `b` has the explicit form {0.2938,0.091,-0.4984,...}). **Now, is there a way to build a sparse array from`a` and `b` without having unpacking in the internal process of creating the sparse array ?** **Refining the question + example below:** The usual `SparseArray[a->b]` command seems have some unpacking in the process although a and b are unaffected. Really, what I'm concerned about is : suppose you have `memA=ByteCount[a]` and `memB=ByteCount[b]`. In the process of constructing `c=SparseArray[a->b]` _I do not want my kernel to suck up all my memory by unpacking a or b (or doing some other unpacking in the internal code)_ , i.e. the kernel memory required during the process should not exceed something like memA+memB, which seems like a very natural requirement to me... In eldo's answer below, it seems there is no unpacking since the arrays considered are too small. Considering larger arrays will lead to the above mentioned problem. **Is there a simple solution (or not so simple) to this issue ?** *Specific example:               On["Packing"]           a=Table[{i, i + 1}, {i, 1, 10000000}]; (* Position of the elements *)     b=Table[RandomReal[], {i, 1, 10000000}]; (* Value of the elements *)     c=SparseArray[{a -> b}]; (* Generating the sparse array *)     ByteCount[a]     ByteCount[b]     ByteCount[c]      > 80000168 > > 80000168 > > 160000952 Plus you get the following messages : > FromPackedArray::punpack: Unpacking array with dimensions {10000000,2} in > call to Rule. >> FromPackedArray::punpack: Unpacking array with dimensions > {10000000} in call to Rule. >> FromPackedArray::punpack1: Unpacking array > with dimensions {10000000}.>> So it seems there is some unpacking in the internal process. In this specific examples the kernel memory during the process goes up by 1 GB, although the final results takes only 160 MB...               $Version      > 8.0 for Mac OS X x86 (64-bit) (October 5, 2011)


On Parameter Estimation using FindDistributionParameters

I am a novice of Mathematica and have recently started my self-study of maximum likelihood estimation (MLE) using Mathematica. I would like to estimate the parameters associated with a distribution following the Laplace distribution. I have created experimental data following the Laplace distribution, using the following code:               data = RandomVariate[ExponentialPowerDistribution[1, 0.5, 1], 1000];      Given the data, I found the shape, location, and scale parameters by using `FindDistributionParameters`:               FindDistributionParameters[data, ExponentialPowerDistribution[Kappa, Mu, Sigma]]      > The obtained result was {1.11375, 0.504605, 1.10716}. But, if my understanding is correct, the Laplacian distribution is not differentiable at "Mu" (the single peak of the distribution), which gives me trouble understanding the estimation results because MLE assumes the differentiability of the distribution function. So, my questions are: (Q1) Are the above estimation results reliable (reasonable, or plausible)? (Q2) If the answer to (Q1) is yes, what is the algorithm used in FindDistributionParameters dealing with the non-differentiability of the distribution function? (Q3) If the answer to (Q1) is no, then, is there any reasonable way to come up with the parameter estimation for the above example? (In fact, I would like to obtain the standard error of each parameter in a reasonable way too.) Thank you very much for your help in advance!


How do I define a function that, when given a list of parameters, plots a family of functions?

So far I've got this:               draw[a_, b_] := Plot[{f[a, b[[1]], x], f[a, b[[2]], x]}, {x, 0, 5}]      The function `draw` will be used like this:               draw[10, {4, 7}]      The example is written for the case with two elements in the list that is the second argument. How do I do it when the second argument is a list with any number of elements?


Position of Subsets in a List

I have a particular list of integers and a matrix whose entries are lists. Say I know that my particular list is a subset of at least some of the elements in the matrix. I want to find an efficient way to find the positions of all of the elements of the matrix of which my list is a subset. Right now, I just loop through all of the entries in the matrix and keep track of which ones entirely contain my list (M is the matrix I want to search through and mylist is my list of integers):               Matches[mylist_] := (     match = {};     Do[Do[If[Intersection[M[[i, j]], mylist] == mylist, match = Append[match, {i, j}]]     ,{j,Length[M[[i]]]}];     ,{i,Length[M]}];     match);      As an example of my desired output:               M = {{{1, 2, 3}, {1, 2, 4}}, {{5, 4, 3}, {1, 2, 1}}};     Matches[{1, 2}]     (*={{1, 1}, {1, 2}, {2, 2}}*)      This function works how I want it to, but in the code I'm working on I wind up using it thousands of times with matrices and lists containing many more elements. Calling it so many times becomes the limiting factor in how quickly my code runs. Are there any ways to accomplish this that would be more efficient? I've tried using Position:               Matches2[mylist_]:=(Position[M, _?(Intersection[#,mylist]==mylist&)]);      Using Intersection in a pattern like this generates errors that I don't know how to correct, though, and I'm not sure whether this approach would be faster to begin with. If anyone knows of any more efficient ways to do this, it would be greatly appreciated. Thanks!


A problem with "RiccatiSolve::ncsol: Cannot compute a stabilizing solution to the matrix equation "

I have a SSM ( State Space Model ) and I want to calculate its optimum gains unisng `LQOutputRegulatorGains[]` command. When I run the code, it solves the equations and give an answer, but this error also appears :                   RiccatiSolve::ncsol: Cannot compute a stabilizing solution to the matrix equation.>>      What's wrong with it ?! And is it possible to change the method which `RiccatiSolve[]` command uses to solve the equation ? It is good to mention that `RiccatiSolve[]` uses two methods : 1.Eigensystem 2.Schur. I don't know how to change the `RiccatiSolve[]` methods in the `LQOutputRegulatorGains[]` command. Thank you in advance.


Adapt ColorFunction in Array Plot

The problem I'm facing is how to adapt `ColorFunction` so that it ranges from green (low values) to red (high values):               ArrayPlot[{a1, a2, a3, a4, a5}, ColorFunction -> (* ??? *)]


Apply an image as a texture to text

I have the following equation               eq = Sum[x^2, {x, 0, 10}]      and an image `image = Import["http://creativity103.com/collections/Graphic/rainbowbars.jpg"]`. How might I output a transparent version of the equation above with the image used as a **tile** for the text. For example I'm looking for something similar to this gradient image expect for the text above. **Edit: it wasn't very clear in the question, but I am looking to tile the background image if possible.** ![enter image description here](http://i.stack.imgur.com/SXSf7.png)


Problem with NDSolve and NDSolve::ivone error

I was trying to solve an diffusion-reaction rate model for the oxidation of Silicon (based on the nice paper by Almeida et.al.) with the help of NDSolve. In this model the boundary conditions are a bit unusual compared to the way Mathematica expects them. The command I tried looks like the following:               res = NDSolve[{      D[nO2[x, t], {t, 1}] == D0 Exp[-(ED/(kB T))] D[nO2[x, t], {x, 2}] -                               K0 Exp[-(EK/(kB T))] nO2[x, t] nSi[x, t],      nO2[0.0, t] == nO20[1, T],      D[nSi[x, t], {t, 1}] == -K0 E^(-(EK/(kB T))) nO2[x, t] nSi[x, t],      nSi[x, 0.0] == 1.0      } //. {      D0 -> 1.291 10^11, ED -> 2.22,      K0 -> 2.022 10^7, EK -> 1.42,       nSi0 -> 0.91 10^15,       kB -> QuantityMagnitude[UnitConvert[Quantity["BoltzmannConstant"/"ElementaryCharge"]]],       T -> 700 + 273.15      }, {nO2, nSi}, {x, 0, 3000}, {t, 0, 60 60}][[1]]      where Mathematica complains about the way how the boundary condition for the function nO2[x,t] has been defined and drops an NDSolve::ivone error. Playing around with this boundary condition I came up with a setup which gave solutions to the functions nO2[x,t] and nSi[x,t], however the choice of the x coordinate for the upper boundary where nO2 is zero is causing a strong influence on the solution as one can see when NDSolve is run for two different settings for the x coordinate:               res = NDSolve[{      D[nO2[x, t], {t, 1}] == D0 Exp[-(ED/(kB T))] D[nO2[x, t], {x, 2}] -                               K0 Exp[-(EK/(kB T))] nO2[x, t] nSi[x, t],      nO2[x, 0.0] == Piecewise[{{0.161/T, x == 0}}, 0],      nO2[3000.0, t] == 0.0,      nO2[0.0, t] == nO20[1, T],      D[nSi[x, t], {t, 1}] == -K0 E^(-(EK/(kB T))) nO2[x, t] nSi[x, t],      nSi[x, 0.0] == 1.0      } //. {      D0 -> 1.291 10^11, ED -> 2.22,      K0 -> 2.022 10^7, EK -> 1.42,       nSi0 -> 0.91 10^15,       kB -> QuantityMagnitude[UnitConvert[Quantity["BoltzmannConstant"/"ElementaryCharge"]]],       T -> 700 + 273.15      }, {nO2, nSi}, {x, 0, 3000}, {t, 0, 60 60}][[1]]     Plot[1 - (nSi /. res)[x, 60 60], {x, 0, 30}, PlotRange -> {0, 1.1}]      yields the following Graph: ![nSiO2 with nO2===0 at x=3000](http://i.stack.imgur.com/zRKNv.png) whereas the following code               res = NDSolve[{      D[nO2[x, t], {t, 1}] == D0 Exp[-(ED/(kB T))] D[nO2[x, t], {x, 2}] -                               K0 Exp[-(EK/(kB T))] nO2[x, t] nSi[x, t],      nO2[x, 0.0] == Piecewise[{{0.161/T, x == 0}}, 0],      nO2[300.0, t] == 0.0,      nO2[0.0, t] == nO20[1, T],      D[nSi[x, t], {t, 1}] == -K0 E^(-(EK/(kB T))) nO2[x, t] nSi[x, t],      nSi[x, 0.0] == 1.0      } //. {      D0 -> 1.291 10^11, ED -> 2.22,      K0 -> 2.022 10^7, EK -> 1.42,       nSi0 -> 0.91 10^15,       kB -> QuantityMagnitude[UnitConvert[Quantity["BoltzmannConstant"/"ElementaryCharge"]]],       T -> 700 + 273.15      }, {nO2, nSi}, {x, 0, 300}, {t, 0, 60 60}][[1]]     Plot[1 - (nSi /. res)[x, 60 60], {x, 0, 30}, PlotRange -> {0, 1.1}]      gives the following graph ![nSiO2 with nO2===0 at x=300](http://i.stack.imgur.com/tNjYr.png) It's obvious that one gets different results by moving the position of the boundary condition and thus using the boundary condition in this way is not an option. I would be interested in finding a possibility to specify the boundary condition for nO2 as shown in the first code snippet.


How to merge Datasets representing matrices with named rows/columns?

I am working with square (non-symmetric) matrices with named rows and columns. The data I receive is sometimes messy and rows/columns may come in various permutations. I usually need to semi-manually put every matrix into a canonical permutation before I can work with it. I'd rather never have to think about permutations and not even define a canonical one, just index the matrices using the names of their rows/columns. I was hoping that `Dataset` would be helpful here, and I made `Dataset` objects like these:               ds1 = Dataset[<|"a" -> <|"a" -> 1, "b" -> 2|>, "b" -> <|"a" -> 3, "b" -> 0|>|>]      ![Mathematica graphics](http://i.stack.imgur.com/NgsA5.png)               ds2 = Dataset[<|"a" -> <|"b" -> 1, "a" -> 5|>, "b" -> <|"b" -> 1, "a" -> 2|>|>] (* I used a different permutation on purpose *)      ![Mathematica graphics](http://i.stack.imgur.com/KkfQn.png) What is the simplest way to merge these together to obtain the following?               Dataset[<|"a" -> <|"a" -> {1, 5}, "b" -> {2, 1}|>, "b" -> <|"a" -> {3, 2}, "b" -> {0, 1}|>|>]      ![Mathematica graphics](http://i.stack.imgur.com/vxdps.png) Instead of merging with `List` I will usually need to merge with other operations, e.g. `Plus`. Once I've built a dataset with `List` it's easy to do that though.


Using MapIndexed[List] on a dataset fails -- why?

The following works:               MapIndexed[List]@{1, 2, 3}     (* {{1, {1}}, {2, {2}}, {3, {3}}} *)      This works too:               Dataset[{1, 2, 3}][MapIndexed[f]]      ![Mathematica graphics](http://i.stack.imgur.com/XbyOa.png) Why does this not work?               Dataset[{1, 2, 3}][MapIndexed[List]]      ![Mathematica graphics](http://i.stack.imgur.com/0yjpN.png) This works fine again:               Dataset[{1, 2, 3}][MapIndexed[{##} &]]      ![Mathematica graphics](http://i.stack.imgur.com/rSeIb.png)


Manipulate expression overlaid on plot of data

I am trying to use the `Manipulate` function in _Mathematica_ and want to plot an expression over a scatterplot of (x,y) data. I can programme the `Manipulate` function, but am unable to do this on the same axes as the scatterplot - any hints much appreciated I want to plot this data and then use `Manipulate` to visually fit a curve to the data... The code I have written for the Manipulate function is:               Manipulate[      Plot[c*k*(x^(c - 1))/((1 + x^c)^(j)), {x, 0, 5},        PlotRange -> {{0, 5}, {0, 10}}], {c, 0, 10}, {k, 0, 10}, {j, 0, 5}]      and I want to include a command so the following plot is included on the axes in the manipulate environment. The following data plot is created with:               ListPlot[ddata, PlotRange -> {{-6, 6}, {0, 0.05}}, AxesOrigin -> {-6, 0}]      ![This is the scatterplot I want in the background...](http://i.stack.imgur.com/HsAs0.jpg) ddata is given by:               ddata = First@ToExpression@Import["http://pastebin.com/raw.php?i=KwJSvA2r", "Data"];


Unable to copy/paste CDF embed code in Ubuntu

I tried this question in superuser but no luck, maybe somebody here knows what is going on... Mathematica offers export to a format they call Computed Document Format (CDF) - it is basically a player for the notebooks you work in that environment. One way to use them is to embed it on a web page. While the pop-up window that generates the embed code offers a way to copy the code to the clip board (this is under Ubuntu), it doesn't appear to register and there is nothing to paste once I get to the text editor to incorporated it in my web page. Any suggestions of what might be amiss would be appreciated. Is there a secondary clipboard where the text goes? Copy/paste works fine otherwise in this software... I run Mathematica 9.0 on Ubuntu 12.04


How to adjust parameters to experimental data on a NDSolve problem

I have 2 differential equations with 2 variables, x and y,which are a function of t and I have the parameters k1, k2 y k3.                                      dx/dt=-k1 x2+ k2 x y                           dy/dt=k1 x2-k2 x y- k3 y      I have to adjust the equations to the following experimental data                                      xo=70.26, x(t=720)=45.78                            xo=71.04, x(t=720)=46.32                            xo=37.23, x(t=720)=24.67                            xo=37.91, x(t=720)=28.78      I tried FindFit and NMinimize. The problem with FindFit is that I have multiple initial conditions. Then I used NMinimize, I tried to create a function error only with the first data (eventually, I will use the rest of the data) but NMinimize gives me the following error This is the funtion.               Remove["Global`*"]      f[k1_?NumericQ,k2_?NumericQ,k3_?NumericQ]:=          Module[{x,y,out},out=Abs[45.78-x[720] /.                NDSolve[{x'[t]==-k1 x[t]^2+k2 x[t]y[t],y'[t]==k1 x[t]^2-k2 x[t]y[t]-k3 y[t],                         x[0]==70.26,y[0]==0},{x,y},{t,0,800}]]]     res=NMinimize[{f},{k1,k2,k3}]      And this is the error > NMinimize::nnum: The function value f is not a number at {k1,k2,k3} = > {8.17269,8.09533,4.9417}. >> If anybody can help


Why is Mathematica 10 giving me the junk data from Instagram?

Instagram:               instagram = ServiceConnect["Instagram"]      ![enter image description here](http://i.stack.imgur.com/uz38Z.png) ServiceExecute[conn,"request",params] sends a request to the connection identified by conn, in my example it is Instagram. This seemed like it would be cool functionality in v10. But almost all queries that I form return missing, incomplete, or just wrong data. Note: I have elided the data for privacy, but rest assured the UserID's are correct. Bugs with this functionality are quite simple indeed to reproduce: Search for a user:               In[3]:= instagram["UserData", "UserID" -> 10206720]          Out[3]= <|"Website" -> "http://barackobama.com", "Username" -> "barackobama",       "FullName" -> "Barack Obama", "Media" -> 179, "FollowedBy" -> 3347187,       "Follows" -> 11, "ID" -> "10206720"|>          Import recent media from a user:          In[5]:= instagram["FollowerCount", "UserID" -> 10206720]          Out[5]= 50


How do I draw a hemisphere?

I want to draw a solid or partially transparent hemisphere above a partially transparent cuboid object in Graphics3D. However, I do not know how to do this s.t. only half the sphere is drawn. Here's what the object looks like with the full sphere:               SphereOpacity = 0.5;     CuboidOpacity = 0.5;     SphereColor = Blue;     CuboidColor = Orange;     Graphics3D[{SphereColor, Opacity[SphereOpacity], Sphere[{0, 0, 0.5}, 0.5],                  CuboidColor, Opacity[CuboidOpacity], Cuboid[{-5, -5, 0}, {5, 5, 0.5}]},                  Boxed -> False     ]      ![enter image description here](http://i.stack.imgur.com/3HWhX.png) How might I proceed to "remove" the bottom half the sphere embedded in the cuboid primitive? In general, is there a way to not render/draw parts of a graphics primitive conditioned intersection with another primitive?