Grid ItemSize is smaller than expected

If I execute `MatrixPlot@IdentityMatrix@100`, the result is a good size. However, if I evaluate               Grid[{{200!}, {MatrixPlot@IdentityMatrix@100}}, ItemSize -> Automatic]      the `MatrixPlot` is much smaller, even when the page is wide. How can I make the `MatrixPlot` appear at its original size in the `Grid`? I'd prefer not to hard-code the size. ![this picture](http://i.stack.imgur.com/8PxEu.png) This picture shows that the second `MatrixPlot` is too small.


Performance tuning for game solving (peg solitaire | senku)

There's a game I saw at a friend's yesterday, that I often see at people's homes, but never for enough time to think on it too hard. It's called peg solitaire (thanks @R.M). So I came home and I wanted to find a solution in Mathematica, so I did the following First, some visual functions. The game consists of a board with some slots that can either have a piece on it (black dot in this visual representation) or be empty (white dot)               empty=Circle[{0,0},0.3];     filled=Disk[{0, 0}, 0.3];          plotBoard[tab_]:=Graphics[GeometricTransformation[#1,TranslationTransform/@          Position[tab, #2]]&@@@{{empty, 0},{filled, 1}}, ImageSize->Small]      The starting board is the following.               tableroStart=({      {-1, -1, 1, 1, 1, -1, -1},      {-1, -1, 1, 1, 1, -1, -1},      {1, 1, 1, 1, 1, 1, 1},      {1, 1, 1, 0, 1, 1, 1},      {1, 1, 1, 1, 1, 1, 1},      {-1, -1, 1, 1, 1, -1, -1},      {-1, -1, 1, 1, 1, -1, -1}     });      -1 is used to represent places where there can't be any pieces. 0 for empty slots. 1 for slots with a piece on it. So,               plotBoard[tableroStart] // Framed      ![Mathematica graphics](http://i.stack.imgur.com/RiPqr.png) Rules: Given a board such as the previous one, you can only move by "taking" a single piece, jumping over it. So, you take a piece, you choose one of the 4 straight directions, you jump over the adjacent piece and fall in an empty slot. The game is won by having only one last piece on the board. So, in the starting board, there are 4 possible moves, all symmetrical. In this code, moves are represented by rules, so, `{3, 4}->{3, 6}` represents a move of the piece in coordinates `{3, 4}`, to coordinates `{3, 6}`, jumping over the piece at `{3, 5}` and taking it out of the board. So, let's start programming. This finds the possible moves towards some specified zero position               findMovesZero[tab_,pos_List]:=pos+#&/@(Join[#, Reverse/@#]&[Thread@{{0, 1, 3, 4}, 2}])//     Extract[ArrayPad[tab, 2],#]&//     Pick[{pos-{2, 0}, pos+{2, 0}, pos-{0, 2}, pos+{0, 2}},UnitStep[Total/@Partition[     #, 2]-2], 1]->pos&//Thread[#, List, 1]&      Lists all the possible moves given a board tab               i:findMoves[tab_]:=i=Flatten[#, 1]&[findMovesZero[tab, #]&/@Position[tab, 0]]      Given the board `tab`, makes the move               makeMove[tab_, posFrom_->posTo_]:=ReplacePart[tab , {posFrom->0, Mean[{posFrom, posTo}]->0,posTo->1}];      Now, the solving function               (* solve, given a board tab, returns a list of subsequent moves to win, or $Failed *)         (* markTab is recursive. If a board is a success, marks it with $Success and makes all subsequent markTab calls return $NotNecessary *)         (* If a board is not a success and doesn't have any more moves, returns $Failed. If it has moves, it just calls itself on every board,     saving the move made in the head of the new boards. I know, weird *)     Module[{$Success,$NotNecessary, parseSol, $guard, markTab},          markTab[tab_/;Count[tab, 1, {2}]===1]:=$Success/;!($guard=False)/;$guard;         i:markTab[tab_]:=With[{moves=findMoves[tab]},(i=If[moves==={}, $Failed,(#[markTab@makeMove[tab, #]]&/@moves)])]/;$guard;         markTab[tab_]/;!$guard:=$NotNecessary;          (* parseSol converts the tree returned by markTab into the list of moves until $Success, or in $Failed *)     parseSol[sol_]/;FreeQ[{sol}, $Success]:=$Failed;     parseSol[sol_]:=sol[[Apply[Sequence,#;;#&/@First@Position[sol, $Success]]]]//#/.r_Rule:>Null/;(Sow[r];False)&//Reap//#[[2, 1]]&;          solve[tab_]:=Block[{$guard=True},parseSol@markTab@tab];     ]      Solution visualization function               plotSolution[tablero_, moves_]:=     MapIndexed[Show[plotBoard[#1], Epilog->{Red,Dashed,Arrow[List@@First@moves[[#2]]]}]&, Rest@FoldList[makeMove[#, #2]&,tablero,moves]]//     Prepend[#, plotBoard[tablero]]&//Grid[Partition[#, 4, 4, 1, Null], Frame->All]&          (* Solves and plots *)     solveNplot = With[{sol=solve[#]},If[sol===$Failed, $Failed, plotSolution[#, sol]]]&;      In action:               solveNplot[( {        {-1, -1, 1, 1, 0, -1, -1},        {-1, -1, 1, 1, 1, -1, -1},        {1, 1, 0, 0, 0, 0, 0},        {1, 1, 0, 0, 0, 0, 0},        {1, 1, 0, 0, 0, 0, 0},        {-1, -1, 1, 1, 1, -1, -1},        {-1, -1, 1, 1, 1, -1, -1}       } )]      returns, after about a min's though, ![Mathematica graphics](http://i.stack.imgur.com/ZXbVR.png) So, the question is. How can we make it efficient enough so it can do the trick for an almost filled board like `tableroStart`? The first move is actually always the same let alone symmetries so we could start a move ahead


My black text isn't black after exporting to PDF

Consider any standard plot, with true CMYK black text:               fakedata =        Transpose@{DatePlus[{2001, 1}, {#, "Month"}] & /@ Range[0, 99],          Accumulate[RandomVariate[NormalDistribution[0, 1], {100}]] - 2};     myplot = DateListPlot[fakedata, Joined -> True,        BaseStyle -> {20, CMYKColor[0, 0, 0, 1]}]      ![Mathematica graphics](http://i.stack.imgur.com/yrIZ9.png) When I `Export` to PDF format, the text does not reproduce as true CMYK black, even if I specify its color as a `CMYKColor`. Rather, it comes out as `CMYKColor[1,1,1,1]`, a mix of all four CMYK colors. This is a nuisance as my use case is to export these graphics for importing into an InDesign document, and the result is fuzzy-looking text. Strangely, the plot's `Frame` is not affected by this problem, which makes me think it is something to do with the text rendering algorithm. Using `ColorConvert` doesn't help because that just rasterizes the image, which looks terrible. It is designed for images, not vector graphics.                Export["test-converted3.pdf", ColorConvert[myplot, "CMYK"]] (* ugliness ensues *)      **While I can fix the problem by getting the graphic designer to re-distill the PDF, I would much prefer to have a direct solution in Mathematica.** There is a supposedly obsolete option `ColorOutput -> "CMYK"`, but it doesn't seem to make a difference. I considered that the issue might be something to do with the way Mathematica antialiases text, but I couldn't work out what setting might affect that. Does anyone have any suggestions for a direct Mathematica solution?


How can I calculate a jigsaw puzzle cut path?

I want to generate a path to cut an arbitrary shape into a set of jigsaw puzzle pieces.   1. All pieces must be unique to preclude placing a piece in the wrong spot.   2. Pieces must be interlocking such that each piece is held by adjacent pieces.   3. It must be possible to generate different paths (sets) for a specific shape that are not merely rotations or reflections of the first. Since jigsaw puzzles are mass produced there must be a known solution. However, my interest is not in simply implementing this solution, rather I am curious to know how one might approach this task, aided by _Mathematica_. I am also interested in alternatives to the standard puzzle piece such as these (even if pieces are not 100% interlocking): ![jigsaw puzzles](http://i.stack.imgur.com/59JKT.jpg)


Why is StringMatchQ["IP1", "IP"] returning False?

Maybe there is a knot in my head, but I would expect that               StringMatchQ["IP1", "IP"]      should return `True` (which it does not) just as               StringFreeQ["IP1", "IP"]      returns `False` (which it does). What am I missing?


Limiting the use of discrete graphics card on Mac

Apple's laptop running Mac OS have a pretty nice feature to make the battery last longer: the dynamically switch between the low-power integrated graphics card and the higher-performance dedicated graphics card depending on app usage. For example, when I have no graphics app running and I launch Mathematica 8.0.4.0, it stays on the integrated graphics card. However, when I run a command that requires 3D output, like `SphericalPlot3D`, it switches to the dedicated graphics card (you don't notice it unless you actually check for it). However, even after I close the notebook with the 3D content, and even if I restart the kernel, Mathematica still continues to grab hold on to the dedicated graphics card, even though it doesn't really need it anymore. (Behind the scences, I imagine it's because it's still retaining an OpenGL context somewhere…) This annoys me, so even though I don't have high hopes, I've got to ask: does anyone have an idea of how I could make it release its hold on the dedicated graphics card?


How to arrange a list on a triangular pattern?

I've made a multiplication table with this: ![enter image description here](http://i.stack.imgur.com/splld.jpg) Then I removed the repeated permutations with:               gg = Range[1, 10]; Subsets[gg, {2}] // TableForm      Now, when the multiplication table has the repeated permutations removed, this table is now similar to a triangle: (1,2) (1,3) (1,4) (1,5) (1,6) (1,7) (1,8) (1,9) (1,10) - 10 multiplications (2,3) (2,4) (2,5) (2,6) (2,7) (2,8) (2,9) (2,10) - 9 multiplications ... (9,10) - 1 multiplication How can I build a triangular table based on this? I'm trying to use arithmetical progression precedure like:               gg = Range[1, 10]; x = 1; gb = {};     While[x <= 9, AppendTo[gb, Take[Subsets[gg, {2}], {H, J}]]; x++]      I was thinking on doing               gg = Range[1, 10]; x = 1; gb = {};     H=0;J=0;     While[x <= 9, AppendTo[gb, Take[Subsets[gg, {2}], {H=H+1, J=J-1}]]; x++]


Extracting coefficients from g=a*x+b*y+c*x*y

I have a Response Surface Equation (RSE) that I'm trying to extract coefficients from. It has a form similar to:               g = a*x + b*y + c*x*y;      I want to be able to extract the coefficient from `x`, `y`, and `x*y`. However, when I use               Coefficient[g, x, 1]      I get `(a + c y)`, which is not what I want (I want just `a`). Is there any way to extract `a`, `b`, and `c` directly?


Displaying subscripted symbols with TraditionalForm

I have pasted this code in from _Mathematica_ 10               << Notation`     Symbolize[ParsedBoxWrapper[SubscriptBox["_", "_"]]]     a = Subscript[q, m]     b = Subscript[q, f]     TraditionalForm[a + b]      Though the definition of `a` and `b` look of identical form when pasted here, I entered `a` explicitly using `Subscript` while `b` is entered q then `Ctrl`+`_`+`f`. The Head of `a` is `Subscript` and the Head of `b` is `Symbol` (which is what I want in order to work with traditional notation in my field). In `TraditionalForm`, `a` is formatted correctly while `b` is formatted as `q\\[Underbracket]Subscript\\[Underbracket]f`. So can I use something of the form `q sub f` as a symbol and still get nice output in traditional form? I this case I think it is useful to post an image capture of the notebook: ![enter image description here](http://i.stack.imgur.com/Y1bMQ.png)


Where can I find a list of functions, specifically views, that can be translated to a C standalone executable?

I want to create a standalone mathematica executable. I would like to have some view capabilities like CreateDialog or TabView or those kinds of things. I would like my users to have an interface to input dynamic strings and variables. I want to do something like this:               function = TabView[{        "General" -> Column[{           Row[{TextCell["Project Name:"], InputField[Dynamic[proj]]}],           Row[{TextCell["Number of Inputs:"], InputField[Dynamic[num]]}]           }],        "Another Tab" -> Plot[x^2, {x, 0, 10}]        }, ControlPlacement -> Left]      Anyone familiar with this process?


How to Align two inline cells

I'm playing with this question: here and here               im=Import["http://hypergroups.github.io/Photos/MathematicaStackExchange/%E4%B8%A4%E4%B8%AA%E5%86%85%E8%81%94%E5%8D%95%E5%85%83%E7%9A%84%E4%B8%AD%E5%BF%83%E5%AF%B9%E9%BD%90.jpg"];          cellExpression1 = Cell[BoxData[ToBoxes[im]], "Text", Background -> Yellow];          cellExpression2 = Cell["
\n    {% for post in site.posts \offset: 0 limit: 25%}\n
<time datetime=\"{{ post.date | \date: \"%Y-%m-%d\" }}\">{{ post.date | date_to_string }}</time> \» {{ post.title }}
\n    {% \endfor %}\n
", "Text", PageWidth -> 500,    CellMargins -> {{50, 30}, {50, 0}}, Background -> Blue];          cellExpression = Cell[BoxData[GridBox[{{cellExpression1, cellExpression2}}]],      "Text", Background -> Red];cellExpression // CellPrint        * question1: pagewidth doesn't work well. I'm tring to make my codes(cell2) into one fixed region, I've tried control the fixed region by `CellMargins.`. It seems GridBox remove the options of cell1 and cell2.   * question2: cell1 and cell2 doesn't align by center horizontal line, how to do that? ![enter image description here](http://i.stack.imgur.com/9cUUD.jpg)


The value of PageWidth doesn't work for saving as HTML?

CellPrint@Cell["Test","Text",PageWidth->300,Background->Red]      And I got this snippet of HTML code：               <p class='Text' style='background-color: #FF0000;'>     Test     </p>      No `width` value, and also in the `.css` file, there is no value `width:300px;` Is this a universe question? I've also tried using a stylesheet with `PageWidth`, sometimes it works, I'm not sure.


How to add the pause button to that dynamic stopwatch?

Referring to How to make a dynamic stopwatch? > Timers can now be created with `timer = makeTimer[]` and utilised with > actions such as `timer["lap"]` to get the current lap time. Timers are > quiescent unless asked to do something. > > You could extend this to handle a pause function if that's required. How do you add that pause button?


Table iteration over two ranges

I am trying to create a `Table` where the iterator has two ranges with different iteration steps. Let's consider a simple example: I want to find the square of the numbers from 1 to 9 in steps of 1 and from 50 to 90 in steps of 10. I could do it like this:               Table[i^2, {i, {1, 2, 3, 4, 5, 6, 7, 8, 9, 9, 50, 60, 70, 80, 90}}]      This needs a lot of typing though. How can I iterate over two ranges without having to type all the numbers by hand?


Boundaries of graphical objects not displayed correctly

I have encountered two situations where _Mathematica_ 10 is mishandling the outer pixels of plainly simple objects. I input this:               Rasterize[Graphics[{}, Background -> Black, ImageSize -> {19, 19}]]      It should basically create a 19x19 pixel black square, but instead I get this: ![Extra white image](http://i.stack.imgur.com/8r9P2.png) If you select the image you will see an extra white pixel row on the top. Indeed, this is because the `ImageDimensions[%]` gives `{19, 20}`. A similar problem occurs with some other pixel sizes. * * * A similar effect takes place in barlegends:               GraphicsRow[{BarLegend[{"DeepSeaColors", {0, 1}}], BarLegend[{"DeepSeaColors", {0, 1}},        LegendLayout -> "ReversedColumn"]}]      These are two bar legends going from 0 to 1, but the second one is reversed. The images look like this: ![enter image description here](http://i.stack.imgur.com/i5ymQ.png) Here, the regular bar legend is okay, but the reversed one misses a thin grey line on one side. **Questions** : Is it a bug? Does is happen only on my machine (Ubuntu 14)? Is it fixable (especially for the Legends)?


Converting function into differential version

I am looking through a journal and I came across a function that I wanted to convert to its differential version using Mathematica. ![enter image description here](http://i.stack.imgur.com/MoElN.png) Would anyone be able to get the differential version by using mathematica?


Apparently contradictory output from Series and D

I defined a function as:               g[b_] := Integrate[f[n]Exp[-b  DA (n.u)^2], n]      Obviously                D[g[b], b] /. b -> 0      gives > >     (-DA)*Integrate[(n.u)^2*f[n], n] >   But, then, how can               Series[g[b], {b, 0, 2}]      be > >     Integrate[f[n], n] >   I guess there is something basic I don't understand. Something with order of evaluation? It's like `b = 0` is evaluated before the differentiation in `Series`.


Representing a Stencil of a Finite Difference Operator with Mathematica's Graphics3D

I have the following finite difference operator: $$ Lu_{ijk}:= du_{ijk} +c(u_{i-1,j,k} + u_{i+1,j,k} + u_{i,j-1,k} + u_{i,j+1,k} + u_{i,j,k-1} + u_{i,j,k+1})\\ -u_{i-1,j+1,k}-u_{i-1,j-1,k} - u_{i-1,j,k-1} - u_{i-1,j,k+1} \\ -u_{i+1,j+1,k}-u_{i+1,j-1,k} - u_{i+1,j,k-1} - u_{i+1,j,k+1} \\ - u_{i,j+1,k-1} - u_{i,j-1,k-1} - u_{i, j+1,k+1} - u_{i,j-1,k+1}, $$ where $d$ and $c$ are known constants. This is way too complex of an expression to expect people to understand, so I want to represent it by a stencil: ![5-point stencil](http://i.stack.imgur.com/WIo79.png) For example, I'd put a sphere of one color (representing $du_{ijk}$) at the origin, a sphere of another color at $(-1,0,0)$, (representing $cu_{i-1,j,k}$), and so on, and finally spheres of a final color at $(-1,1,0)$ (representing $-u_{i-1,j+1,k}$). My preliminary _Mathematica_ commands are:               Graphics3D[{Specularity[White, 10], Red, Sphere[{0, 0, 0}],                 Blue, Sphere[{0, 0, 1}], Sphere[{1, 0, 0}], Sphere[{-1, 0, 0}],                 Sphere[{0, -1, 0}], Sphere[{0, 0, -1}],                 Green, Sphere[{1, 1, 0}], Sphere[{1, 0, 1}]}, Boxed -> False]      but these spheres are way too big and cover each other up. How can this be fixed?


How do I overlay corresponding values over each frame of an animation?

I recorded a phenomenon using video capturing (`phen.avi`, imported into _Mathematica_ ) and simultaneous measurement of some electrical properties of that phenomenon (a list with values). For every frame, there is a corresponding value, which I would like to a) overlay directly on each frame (is it possible to convert numbers into graphics and then use `ImageCompose[]`?); and b) animate these values in an "electrocardiogram"-style, so values vs. "rolling time". This should be possible with `Animate[]`, but do I have to split this animation into single images in order to overlay it onto `phen.avi`, or is there a more direct way?


How to control divider length in a grid

I want to display a table like this: ![enter image description here](http://i.stack.imgur.com/xnhdp.jpg) And use `Divider` I can only get this so far               t=Table[x, {10}, {10}];         Grid[t,           Dividers -> {{{{True, False}}, {-1 -> False,               1 -> False}}, {{{True, False}}, {-1 -> False, 1 -> False}}}]      ![enter image description here](http://i.stack.imgur.com/8fpUV.jpg) How can I remove the extra part of the divider?


Find maximum from NDSolve output

Here is my code:               rawdata = http://pastebin.com/fgeZrSCp (* I hope pastebin is OK *)          f[x_] := Interpolation[rawdata, InterpolationOrder->1][(x + 1)*10]       (* just creating a function with the data *)     d = 0.05;     T = 0.8;     wn = 2 Pi/T;     wd = wn*Sqrt[1 - d^2];          sol =        NDSolve[{xx''[t] + 2 d wn*xx'[t] + wn^2 xx[t] == -f[t], xx[0] == 0, xx'[0] == 0}, xx,          {t, 0, 65}, MaxSteps -> 500000];     Plot[Evaluate[xx[t] /. sol], {t, 0, 65}, PlotRange -> All]      ![Plot of the solution](http://i.stack.imgur.com/9y97O.png) My goal is to get the maximum value of `Abs[xx[t]]`. How can I do this in an efficient way? Note that `d` and `T` can change. In this particular example the maximum should be around 0.052. Context: Structural Dynamics, I'm trying to find a "response spectrum".


Exporting combined data plots as a PDF file

I am trying to export a graph similar to the one attached as PDF. I am having troubles with the error bars and legends. ![enter image description here](http://i.stack.imgur.com/yrR7x.png) Is there a simple example someone can share and demonstrate how to do this?


Evaluating a SmoothKernelDistribution at a point

I would like to evaluate the value of the following SmoothKernelDistribution at the location, say, 2.35. What is the right way to do it?               data1 = {1, 2, 3};     DD = SmoothKernelDistribution[data1, 0.5];     Plot[PDF[DD, x], {x, -2, 10}]


How can i execute several Commands in one text file and use it in notebook?

I want to execute several commands in one text file and use it in notebook by Get[] command. for example:               a=Plot[x^2 ,{x,0,2}];     b=ListPlot[{{0.327081,9.94393},{0.327081,0.102804}},Joined->True];     Show[a,b,PlotRange->All,,PlotLabel->hy]     a1=Plot[26x^2 - 19x,{x,0,3}];     b1=Plot[-2x^2 ,{x,2,3}];     Show[a1,b1,PlotRange->All,PlotLabel->sx]        I want to see both plots.But Mathematica run only last command in text file


What is the difference between prefix/postfix notations and map?

I am new to _Mathematica_ and just experimenting with the different programming constructs. I have been looking at `Map` and how to evaluate a function for a list of values and there seems to quite a number of different ways of doing this. I have used `Trace` to look at what goes on in more detail but is there any difference in the approaches shown below other than syntax? In my example, both `@` and `/@` appear to be equivalent to `Map`.               f[x_] := x^2;         f /@ {1, 2, 3} // Trace      > {f /@ {1, 2, 3}, {f[1], f[2], f[3]}, {f[1], 1^2, 1}, {f[2], 2^2, 4}, {f[3], > 3^2, 9}, {1, 4, 9}}               f @ {1, 2, 3} // Trace      > {f[{1, 2, 3}], {1, 2, 3}^2, {1^2, 2^2, 3^2}, {1^2, 1}, {2^2, 4}, {3^2, 9}, > {1, 4, 9}}               f[{1, 2, 3}] // Trace      > {f[{1, 2, 3}], {1, 2, 3}^2, {1^2, 2^2, 3^2}, {1^2, 1}, {2^2, 4}, {3^2, 9}, > {1, 4, 9}}               {1, 2, 3} // f // Trace      > {f[{1, 2, 3}], {1, 2, 3}^2, {1^2, 2^2, 3^2}, {1^2, 1}, {2^2, 4}, {3^2, 9}, > {1, 4, 9}}


Plotting3D Cylinders and planes

How can I plot3D cylinders $y=1-x^2, y=1+x^2$ and planes $2x+2y-z=10, x+y+z=2$ in **a** coordinates system?(with Mathematica)


Sqrt disappeared when exporting plot to PDF in version 10

In version 10, if we plot with `Sqrt` in y-axis, and export to PDF, the square root disappears in the PDF file.               p = Plot[x, {x, 0, 1}, Frame -> True,        FrameLabel -> {"x", "\!\(\*SqrtBox[\(y\)]\)"}]          Export["test.pdf", p]      This does not happen in version 9.


How can I retrieve the point coordinates from a LOG Plot after the data points were manually moved?

I'm having problems with getting coordinates out ofa `ListLogLogPlot` I basically plotted a list, then selected data points on the graph, moved these points around, and now I need to get the coordinates of the moved points. Any ideas? ![http://i.stack.imgur.com/5fhai.png](http://i.stack.imgur.com/S4wGH.png) ![enter image description here](http://i.stack.imgur.com/bQ2I9.png)


Generating a random walk with defined step size

By the following I'm trying to generate a list of random coordinates (ex. 4) each within unit distance from previous one, starting from origin. What am I doing wrong?               o = {0, 0, 0};          RP = Module[{},       RN = RandomReal[1000, 3];       RV1 = RN/(2*RootMeanSquare[RN]);      o = RV1 + o;      RV2 = {};      RV2 = Append[RV2, o]      ]          In[231]:= Do[RP, {i, 1, 4}]     RV2


If statement and elements of an imported data

I import a data file:               SetDirectory["C:\\Users\\SE7EN\\Desktop\\mathematica\\test"];     dd = Import["data.dat", "Table"]          Out[2] = {{1}, {2}, {3}, {4}, {5}, {6}, {7}}      and I want to apply the statement below on the elements of the data file but it doesn't work               For[i = 1, i < 7,        i++, {If[dd[[i]] < dd[[i + 1]], Print[dd[[i + 1]]],          If[i > 5, Print[dd[[i]]]]]}];      Of course there are some other ways to the goal of the program but I want to work with the elements of an imported data file directly in the first of IF statement.


How to change variable that has been defined in PDE?

I have a PDE function that contains a variable (named ka). I want to plot the result of my PDE in 1 plot using several different ka values. However, I'm not sure about how to write down this equation. So far I can Plot this result but only by using a defined value. Is it possible to change my ka value? If it is not possible, let say that I dont have a single ka value, how can I insert this value in the middle of the equation? I put my code below               (*DATA*)     kw = 10^(-10);(*m/s*)     ka = 10^(-10);(*m/s*)     gw = 10;(*N/m^3*)     m2w = -2*10^(-4);(*coefficient of compressibility of water phase with respect to matric suction*)     m1w = -0.5*10^(-4);(*coefficient of compressibility of water phase with respect to axial stress*)     m2a = 1*10^(-4);(*coefficient of compressibility with air phase with respect to matric suction*)     m1a = -2*10^(-4);(*coefficient of compressibility of air phase with respect to axial stress*)          tmin = 0;(*minimum or time when the pressure is applied*)     tmax = 10^10;(*latest inspected time*)     zmin = 0;(*top elevation*)     zmax = 10;(*bottom elevation*)     uatm = 101;(*kPa-atmospheric air pressure*)     step = 5000;(*The higher the step, the higher the accuracy*)     uwi = 40;(*Initial water pressure*)     uai = 20;(*initial air pressure*)          temp = 293.16;(*temperature in kelvin*)     wa = 28.97*10^(-3);(*kg/mol*)     s = 0.8;     n = 0.5;     (*CALCULATION*)     r = 8.31432;(*Universal gas constant in j/(mol K*)     g = 10;(*gravity acceleration-m2/s*)     da = ka/g;     cwv = kw/(gw*m2w)     cw = ((1 - m2w/m1w)/(m2w/m1w))     ca = (m2a/m1a)/(1 - (m2a/m1a) - (1 - s)*n/(uatm*m1a))     cav = da/(wa/(r*temp)*m1a*uatm*(1 - m2a/m1a - (1 - s)*n/(uatm*m1a)))     cws = m1w/m2w;     cas = 1/(1 - (m2a/m1a) - n*(1 - s)/(uatm*m1a));     dt = tmax - tmin;     is = 300;(*ImageSize*)          (*Calculation*)     q[t]=100*(1-Exp[-0.00005*t]);               (*Coupled equation*)     eq1 = -Derivative[2, 0][uw][z, t]*cwv - Derivative[0, 1][ua][z, t]*cw + (D[q[t], t]*cws) == Derivative[0, 1][uw][z, t];     eq2 = -Derivative[2, 0][ua][z, t]*cav - Derivative[0, 1][uw][z, t]*ca + (D[q[t], t]*cas) == Derivative[0, 1][ua][z, t];          (*Boundary condition*)     ic1 = {uw[z, tmin] == uwi, Derivative[1, 0][uw][zmin, t] == 0, uw[zmax, t] == 0};     ic2 = {ua[z, tmin] == uai, ua[zmin, t] == 0, Derivative[1, 0][ua][zmax, t] == 0};          sol2 = NDSolve[Flatten[{eq1, eq2, ic1, ic2}], {uw, ua}, {z, zmin, zmax}, {t, tmin,tmax}, MaxSteps -> Infinity, MaxStepSize -> dt/step, InterpolationOrder -> All]          Column[Manipulate[Plot[uw[z, t] /. sol2, {z, zmin, zmax}, PlotRange -> Full, AxesLabel -> {z, uw[z, t]}], {t, tmin, tmax}],Manipulate[LogLinearPlot[(uw[z, t] /. sol2), {t, tmin + 0.1, tmax}, PlotRange -> Full, AxesLabel -> {t, uw[z, t]}], {z, zmin, zmax}]]      Regards Martin Wijaya


Solving an equation for asymptotic dependence of the solution on a coefficient

I have an equation I want to solve, so I entered the following into _Mathematica_.               (x^(17/6))/(a^(17/6)) - (x^2)/a -1 == 0      where I assume $a>>1$ and $x$ is the unknown. How do I compute the dependence of $x$ on $a$ as $a \rightarrow \infty$.


Generating an array using list values at indices corresponding to entries in a separate list satisfying some criterion

Imagine one has an array of integer value sets that looks like this:               testValues = {{9, 8, 8, 10, 1}, {10, 0, 0, 1, 0}, {8, 0, 0, 5, 7}, {1, 5, 7, 2, 7}, {6, 9, 3, 9, 10}, {7, 10, 7, 5, 3}, {3, 10, 6, 1, 9}, {5, 8, 7, 9, 2}, {2, 3, 2, 7, 0}, {3, 7, 10, 2, 7}};      And a set of lists that looks like this:               listA = {1,2,3,4,5,6,7,8,9,10};     listB = {1,2,3,4,5};     listR = {{67,56,55,33,24,32,54,667,99,103498},{5}};     listQ = {{653,29,49,69,19},{20987}}      Here, `Length[listA] == Length[listR[[1]]]`, `Length[listB] == Length[listQ[[1]]]`, and the number of entries in `testValues` is `Length[listA]*Length[listB]`. I want to very quickly output an array with entries:               {{listR[[a, 1]], listQ[[b, 1]]},...}      For all `{a,b}` pairs where `testValues[[a,b]] >= threshold` for some integer `threshold` value. The entries in the array do not need to be in any particular order. The naive way of proceeding could look like:               outputList ={};          For[a = 1, a <= Length[listA], a++,       For[b = 1, b <= Length[listB], b++,              If[testValues[[a, b]] >= threshold,           outputList = Append[outputList, {listR[[a, 1]], listQ[[b, 1]]}];           ];              ];       ];      However, this is quite slow. Is there a much faster method using `Select` perhaps? The relevant list sizes are in reality something like `Length[listA]` $\approx 10^2$, `Length[listB]` $\approx 10^4$, and `testValues` has `Length[listA]*Length[listB]` entries. * * * Update: I was able to use Position to do the following:               goodIndices = Position[int, x_ /; x >= 3];     outputList[[i]] = {listR[[#[[1]], 1]], listQ[[#[[2]], 1]]} & /@ goodIndices;      This is about 4x faster than the naive approach I posted earlier. Are further speedups possible?


Custom WindowToolbar for my stylesheet

So I've noticed that some stylesheets (for instance Slideshow stylesheets) load a toolbar using the assignment `WindowToolbars -> {"ToolbarName"}` and I've been wondering whether it's possible to prepare and load a custom one using this mechanism. I've searched Mathematica directories but I couldn't find the toolbars source directory.


Is there documentation on the comparative performance of Mathematica functions?

Recently I have been solving some Project Euler problems. I find there are always several ways to do the same thing. For example, one could join two lists like this:               a = {2, 1};     b = {2, 3};     Union[a, b]     Join[a, b]      Which gives > {1, 2, 3}   >  {2, 1, 2, 3} So the `Union` function sorts the element and deletes duplicates. I guess the `Join` function will be faster, but how much faster? In a loop, would it be more efficient to use `Join` and `DeleteDuplicates` at each 100th step? Is there documentation of the comparative performance of _Mathematica_ functions? Because heuristics as above could be totally wrong, and I don't know how much experimenting it would take to form a good understanding of the complexity of functions.


Identify / change working directory for the InstallableNET runtime

I am currently attempting to use .NET/link to call a third party DLL from _Mathematica_ using `DLLDefinedFunction`. I have been able to link against and call many of the functions in the DLL, but have encountered issues with one function in particular, which attempts to read in data from a file whose path is hard-coded relative to the current working directory. Forgive my ignorance, but as I am not "au fait" with .NET, I don't know how to determine what InstallableNET32.exe is using as its working directory, or how to change it to something else. (I do know how to change the working directory for the MathKernel, but based on my experimentation, any changes to the kernel's working directory do not appear to "flow through" to the InstallableNET runtime.) Could someone please provide guidance on how I can identify, and then change, the working directory being used by the InstallableNET runtime (Is this an example of another undocumented feature in .NET/link, like the `"Force32Bit"->True` option?)


How can you show data in a CDF Animate Graphic?

I want to show (dynamically) the curvature and torsion in a CDF to understand the quantitative measure of any points. Do you know what I have to do to show data in a `Animate` graph? https://www.dropbox.com/s/85sy5bg9c96f818/Helice%20Pagina%2090%20OK%20TOTAL.cdf I want to view curvature and torsion in different curves to understanding the graphical sense. Thank you. * * * I add the code where i want to see dynamically the curvature and torsion Hello, what i want if to visualize the curvatura and torsion in every point where you can see the Frenet-3 vectors               Clear[a]     r[t_] := {Sin[t], Cos[t], a*t}     uT[t_] := Simplify[r'[t]/Norm[r'[t]], t \[Element] Reals]     vN[t_] := Simplify[uT'[t]/Norm[uT'[t]], t \[Element] Reals]     vB[t_] :=       Simplify[Cross[r'[t], r''[t]]/Norm[Cross[r'[t], r''[t]]],        t \[Element] Reals]     {uT[t], vN[t], vB[t]} // Column // TraditionalForm          rp1[t_] = Simplify[D[r[t], t]]     rp2[t_] = Simplify[D[rp1[t], t]]     rp3[t_] = Simplify[D[rp2[t], t]]          {rp1[t], rp2[t], rp3[t]} // Column // TraditionalForm          (*rr[t_]:=Simplify[r[t],t\[Element]Reals]     {rr[t]}//Column//TraditionalForm*)          curvatura[t_] :=       Sqrt[Cross[rp1[t], rp2[t]].Cross[rp1[t], rp2[t]]]/(Sqrt[          rp1[t].rp1[t]]^3)     Print["curv ", curvatura[t]]     Print["curv ", N[ curvatura[2]]]     Print["curv ", curvatura[Pi/2]]     Print["curv ", curvatura[Pi]]          torsion[t_] :=       Det[{rp1[t], rp2[t], rp3[t]}]/       Sqrt[Cross[rp1[t], rp2[t]].Cross[rp1[t], rp2[t]]]     Print["tors ", torsion[t]]     Print["tors ", N[torsion[2]]]     Print["tors ", torsion[Pi/2]]     Print["tors ", torsion[Pi]]          Simplify[Norm /@ {uT[t], vN[t], vB[t]}, t \[Element] Reals]     Manipulate[      Show[ParametricPlot3D[{r[t]}, {t, -Pi/a, Pi/a},         PlotStyle -> {Blue, Thick}],        Graphics3D[{{Thick, Darker@Red,           Arrow[{r[s], r[s] + uT[s]}]}, {Thick, Darker@Green,           Arrow[{r[s], r[s] + vB[s]}]}, {Thick, Darker@Cyan,           Arrow[{r[s], r[s] + vN[s]}]}}],(*Print[curvatura[r,s]],Print[       torsion[r,s]],*)PlotRange -> {{-2, 2}, {-2, 2}, {-Pi, Pi}},        ViewPoint -> {3, -2, 2}],       Style["Representación espacial de la noria del hamster", 12,        Bold], Delimiter, {{a, 0.5, "a (elegir valor entre -1 y 1)"}, -1, 1,        Appearance -> "Open"}, Delimiter, {{s, -Pi,         "Valor del parametro en el que se visualizar el Triedro de \     Frenet"}, -Pi/a, Pi/a,        Appearance ->         "Open"},(*Delimiter,Style["Curva Azul.- Representación de la \     curva" r[u],Darker@Blue],*)Style["Curvatura ", curvatura[s]],       Style["Torsión ", torsion[s]],      Style["Vertor Rojo.- Representa el vector Tangente", Darker@Red],       Style["Vector Cyan.- Representa el vector Normal", Darker@Cyan],       Style["Vector Verde.- Representa el vector Binormal", Darker@Green],       ControlPlacement -> Left, SaveDefinitions -> True]      * * *


plotting an equation with double summations

Thank you so much for the helpful comments. Now able to manage to plot all the functions.               Remove[q, qC, IIC]          ass = {d > 1, num > 0, \[CapitalDelta] > 0, t > 0, n >= 0};          q[\[Nu]_, num_, \[CapitalDelta]_, t_] :=       1/num (1 +          2 Exp[-\[Nu]] NSum[           Sin[(\[Pi] d)/num]/((\[Pi] d)/num) Exp[-d \[CapitalDelta]^2]             Cos[(\[Pi] d)/num (2 t + 1)] \[Nu]^(n + d/2)/Sqrt[            n! (n + d)!], {d, 1, 10}, {n, 0, 10}])          AbsoluteTiming[Table[q[2, 4, 0.2, t], {t, 0, 200, 20}]]          Plot[q[2.0, 4.0, 0.2, t], {t, 0, 200}]          qC[\[Nu]_, num_, \[CapitalDelta]_, t_] :=        1/num (1 +           2 Exp[-\[Nu]] Sum[            Sin[(\[Pi] d)/num]/((\[Pi] d)/num) Exp[-d \[CapitalDelta]^2]              Cos[(\[Pi] d)/num (2 t + 1)] \[Nu]^(n + d/2)/Sqrt[             n! (n + d)!], {d, 1, 20}, {n, 0, 20}]);          AbsoluteTiming[Table[qC[2., 4., 0.2, t], {t, 0, 200, 10}]]          ListPlot[Table[{t, qC[2, 4, 0.2, t]}, {t, 0, 200}]]          IIC[\[Nu]_, num_, \[CapitalDelta]_] :=       Log[2, num] - Sum[(q[[Nu], num, [CapitalDelta], t]) Log[2, q[[Nu], num, [CapitalDelta], t]], {t, 0, num - 1}]; AbsoluteTiming[Table[IIC[[Nu], 4, 0.2], {[Nu], 1, 200, 20}]] ListPlot[Table[{[Nu], IIC[[Nu], 4, 0.2]}, {[Nu], 1, 50}], PlotRange -> All, AxesOrigin -> {0, 0}]


Problem with | operator in pattern matching

My first question here as I only got into _Mathematica_ programming recently. Basically I have a large symbolic algebraic expression where I know certain variables with head pε appear with degree 2 in each term. So the terms look like this:               (...) pε[i, j] pε[k, l] + (...) pε[m ,n] pε[p, q] + ...      I want to pick out which of these appear in my expression, and I figured out this would do the trick               (Reap[expr /. patt : (x_pe y_pe | _pe _pe) :> Sow[patt] ;][[2,1]]) // DeleteDuplicates      which gives: > {pe[4, 6]^2, pe[3, 6]^2, pe[2, 6]^2, pe[5, 6]^2, pe[3, 6] pe[4, 6], pe[3, 6] > pe[5, 6], pe[4, 6] pe[5, 6]} This however is missing terms because, when I ran two sets of pattern matches without `|`, I get more terms               (Reap[expr /. patt : x_pe y_pe :> Sow[patt] ;      expr /. patt : _pe _pe :> Sow[patt] ;][[2,1]]) // DeleteDuplicates      > {pe[3, 6] pe[4, 6], pe[2, 6] pe[4, 6], pe[2, 6] pe[3, 6], pe[3, 6] pe[5, 6], > pe[4, 6] pe[5, 6], pe[2, 6] pe[5, 6], pe[4, 6]^2, pe[3, 6]^2, pe[2, 6]^2, > pe[5, 6]^2} So I would like to know what's going on. In particular I imagine the first would be a lot more efficient if it worked properly. Also feel free to give alternative ways of doing this. My choice of using `Reap, Sow` was one of efficiency but my of knowledge of the language is still small. ### Edit Based on the example given by @Federico I have constructed a small analogue where the difficulties are manifest, I use `Cases` because it's conceptually clearer               sum = Sum[pe[i, j] l[i, j] pe[j, k], {i, 3}, {j, 3}, {k, 3}]      whose output is: > l[1, 1] pe[1, 1]^2 + l[1, 1] pe[1, 1] pe[1, 2] + l[1, 1] pe[1, 1] pe[1, 3] + > l[2, 1] pe[1, 1] pe[2, 1] + l[1, 2] pe[1, 2] pe[2, 1] + l[2, 1] pe[1, 2] > pe[2, 1] + l[2, 1] pe[1, 3] pe[2, 1] + l[1, 2] pe[1, 2] pe[2, 2] + l[2, 2] > pe[2, 1] pe[2, 2] + l[2, 2] pe[2, 2]^2 + l[1, 2] pe[1, 2] pe[2, 3] + l[2, 2] > pe[2, 2] pe[2, 3] + l[3, 1] pe[1, 1] pe[3, 1] + l[3, 1] pe[1, 2] pe[3, 1] + > l[1, 3] pe[1, 3] pe[3, 1] + l[3, 1] pe[1, 3] pe[3, 1] + l[2, 3] pe[2, 3] > pe[3, 1] + l[1, 3] pe[1, 3] pe[3, 2] + l[3, 2] pe[2, 1] pe[3, 2] + l[3, 2] > pe[2, 2] pe[3, 2] + l[2, 3] pe[2, 3] pe[3, 2] + l[3, 2] pe[2, 3] pe[3, 2] + > l[1, 3] pe[1, 3] pe[3, 3] + l[2, 3] pe[2, 3] pe[3, 3] + l[3, 3] pe[3, 1] > pe[3, 3] + l[3, 3] pe[3, 2] pe[3, 3] + l[3, 3] pe[3, 3]^2 So there are two types of terms those that contain `pe` squared and those that don't. Those that do are captured by               Cases[sum, _pe^2, Infinity]      those that don't require               Cases[sum, _ x_pe y_pe -> x y, Infinity]      So the question now is why does the following also work for the case with no `pe` squared?               (Reap[sum /. patt : (x_pe y_pe) :> Sow[patt]; ][[2,1]])      And a followup question, how would one capture the squared terms if _Mathematica_ didn't collect them in a square? For example, if I had `pe[1, 1]l[1, 1] pe[1, 1]` can I construct a pattern to capture this? Or will it never happen due to `Times` having the `Orderless` attribute? I am thinking of a situation where `l[1,1]` is very large and _Mathematica_ doeesn't order it. Another question is can I combine both pattern matching cases in one with the use of `|`, and, if so, would that be more efficient?


Rasterized image together with vector-graphics axes

Following some of the questions here on _Mathematica_ Stack Exchange, I am trying to export an image that contains a rasterized object and vector- graphics axes. Here is an example:               myArray = Table[{x, y, RandomReal[]}, {x, 0, 100}, {y, 0, 100}];          size = 500;          myImage =       ListDensityPlot[Flatten[myArray, 1], Mesh -> 20,        ColorFunction -> "AvocadoColors", PerformanceGoal -> "Quality",        FrameLabel -> {"\[Mu]", "C"}, FrameStyle -> Directive[14],        ImageSize -> size];          img = Rasterize[Show[myImage, Frame -> None], ImageResolution -> 100,         ImageSize -> size];          g = Graphics[       Inset[img, Scaled[{0.5, 0.5}], {Center, Center}, size],        AbsoluteOptions[myImage]]      Here is the result:: ![enter image description here](http://i.stack.imgur.com/rV92A.png) You can notice, if you compare with the original image, that the scaling of the inserted object is not correct. Now two my questions:   1. How to figure out the size of the object that I insert automatically. Here, if I replace `size` with `0.21 size` I will get a correct image. Why is 0.21?   2. Why the size of ticks and numbering does not coincide with the original image and how to fix it?


Using triangulation

I have been presented with 3 known points and the power densities at those points. I need to use those points to find the location of the actual antenna which is generating the signals. Power Density is calculated through $PD=(power by antenna)/4*Pi*R^2$ and the inverse law also applies, $PD=\frac{1}{R^2}$, where R is the distance between a known point and the antenna. What is the best method of apporaching this problem using the Mathematica enviroment? Till now I havent been able to tackle this problem mathematically aswell, as I don't know how it would be done. I did however come across something, which said plotting circles will be the best, and their intersections will give the coordinates? how will this work? This is the module where I have to write the code:               Triangulate[measure_] := Module[(* Enter your code here*)]       `measure_` contains 3 lists, e.g you would input               Triangulate[{{2000,0,1/2},{0,1000,1},{0,0,1/2}}]      where first two elements are the x and y coordinates, and the last element is the power density at those points. Any help to get me started will be appreciated, cause at the moment i dont know how to start or tackle this.


Force multiplication by a single factor

I have an expression that Mathematica decides to return in the general form:               y =  f ( a/f + b/Sqrt[f + 2] + c*f^2/Sqrt[f + 2])      (actually my expression is much longer and the coefficients `a`, `b`, `c` are more complicated). Ultimately I want to set `f` to zero, however if I do it using `y /. f -> 0` Mathematica returns `Indeterminate`. Obviously from the form of the equation this is incorrect, since `y` is well defined in this case. Use of functions such as `Limit`, `Expand` etc are basically out the questions since I'd like to keep the coefficients `a`, `b`, `c` as they are (and they are too complicated to think of inputing them into a `Hold` function. Is there a way that I can force Mathematica to simply multiply through by `f`, so that I can use `Replace`? Thanks a lot in advance for your help.


Integration with vector coefficients

I asked this same question in Mathematics, and it was suggested I might try here. I'm more comfortable with Maple, but if I can get Mathematica to do what I'm after, so much the better. Basically I'm trying to symbolically integrate something like this: $\displaystyle\int \frac{a\mu-b}{||a\mu-b||^3} \mathrm{d}\mu$ where $a,b$ are vectors and $\mu$ is a scalar. The denominator is the cube of the 2-norm of the vector, and can be found by taking the dot product of a vector with itself, and raising it to the power of $\frac{3}{2}$. Right now in Maple I'm explicitly multiplying out the denominator and making substitutions so that the denominator, at least, is only in terms of scalars ($a \cdot a = C$, etc. ), but I hate doing it this way, because it adds a lot of bookkeeping. Basically I'd like the computer to understand that $a * (b \cdot a)$ is not the same thing as $b * a^2$, but that $a \cdot b * c \cdot d = c \cdot d * a \cdot b$. What's the most kosher way to do this integration in Mathematica? **UPDATE** This is the full integral I'm trying to do. I'm not sure it even has an answer, but the first integral is similar to what I have above. So I was hoping I could take any techniques that work on the simpler one above and apply them to the full problem below. Let: $\vec{f} = (a - c) \mu_1 + (b - c) \upsilon_1 - (x - z) \mu_2 - (y-z) \upsilon_2 - (z - c) $ where $a, b, c, x, y, z$ are vectors representing positions, and $\mu_1, \nu_1, \mu_2, \nu_2$ are scalars. I want to find: $\vec{F_G} = \displaystyle\int_0^1 \int_0^{1-v_2} \int_0^{1} \int_0^{1-v_1} \! \frac{f}{||{f}||^3} \, \mathrm{d} \mu_1 \mathrm{d} \upsilon_1 \mathrm{d} \mu_2 \mathrm{d} \upsilon_2 $


Symbolically associate vectors and their norms

I am wondering how to handle the following situation: I do have vectors of known dimension that I would like to handle symbolically. I suppose I can do something like               avec = Array[a,2];     bvec = Array[b,2];      Now in my equations there are also scalars that represent the norms of these vectors, i.e. `A == Norm[avec]` So suppose I write an expression like               expr = A avec.(avec + bvec)      What I would like Mathematica to do is:   1. Whenever `avec.avec` is encountered, replace this by A^2   2. Whenever `avec.bvec` is encountered, leave this symbolic, don't expand into the elements of the vectors. How can I achieve this?


Baffling increase in runtime

**Background of my question** I discovered Project Euler today, and decided I would work through the problems in Mathematica. I became obsessed with the first problem, which is essentially _"sum all the numbers from 0 to n that are multiples of 3 or 5"_. I came up with several interesting solutions, and decided I would compare their runtimes to see if there is a way to optimize this calculation. While amusing myself with `ListPlot`'s of runtimes, I noticed some very interesting behavior in my solution that uses `Fold`:               FoldSum[m_, n_] :=       Fold[If[Mod[#2, 3] == 0 || Mod[#2, 5] == 0, #1 + #2, #1] &, 0, Range[m, n]]     FoldSum[n_] := FoldSum[0, n]      I came up with this plotting function in order to visualize the runtimes of the summing functions as _n_ increased. (In order to maintain fairness amongst trials, I called `ClearSystemCache[]` just to ensure caching benefits are not messing with the independence of trials).               PlotSum[f_, a_, b_, step_] :=       ListPlot[{#, (ClearSystemCache[]; First[AbsoluteTiming[f[#]]])} & /@         Range[a, b, step], AxesOrigin -> {a, 0}]     PlotSum[f_, b_, step_] := PlotSum[f, 0, b, step]      It was quite interesting to generate graphs comparing the different summing functions I came up with (I listed them below in a separate section). For example, I would plot FoldSum's runtime from n = 0 to n = 999 in steps of 10 by executing `PlotSum[FoldSum, 999, 10]` **The question** My question pertains to the plot of FoldSum - I noticed that around n = 96000, the runtime of FoldSum suddenly jumps by a factor of around 15. I used the plotting function to generate smaller and smaller ranges until I finally found this:               In[1] = FoldSum[95934] // AbsoluteTiming     Out[1] = {0.020469, 2147472998}          In[2] = FoldSum[95935] // AbsoluteTiming     Out[2] = {0.303367, 2147568933}      ![the specific plot](http://i.stack.imgur.com/muid9.png) My question is, what is so special about numbers greater than 95934 (i.e. why does the runtime suddenly jump by a factor of around 15)? Is it just my computer that does this, or is this reproducible? **Some other fun stuff** In case you actually threw this into Mathematica to reproduce these results, you might enjoy these other solutions:               ListSum[m_, n_] :=       Total[Select[Range[m, n], Mod[#, 3] == 0 || Mod[#, 5] == 0 &]]          TransposeSum[m_, n_] :=       Total[First /@         Select[Transpose[{Range[m, n], Mod[Range[m, n], 3],            Mod[Range[m, n], 5]}], #[[2]] == 0 || #[[3]] == 0 &]]          ConcurrentSum[m_, n_] :=       ParallelSum[If[Mod[i, 3] == 0 || Mod[i, 5] == 0, i, 0], {i, m, n}]          ParallelListSum[m_, n_] :=       Total[Level[        ParallelCombine[ListSum[First[#], Last[#]] &, Range[m, n]], 1]]          ParallelizeSum[f_, m_, n_] :=       Total[Level[ParallelCombine[f[First[#], Last[#]] &, Range[m, n]],         1]]     ParallelizeSum[f_, n_] := ParallelizeSum[f, 0, n]     (* ParallelizeSum[FoldSum, 999] *)      also, to graph a comparison plot between different solutions,               PlotCompare[fList_, m_, n_, step_] :=       ListPlot[PlotSumData[#, m, n, step] & /@ fList]     PlotSumData[f_, m_, n_,        step_] := {#, First[AbsoluteTiming[(ClearSystemCache[]; f[#])]]} & /@        Range[m, n, step]


Plotting Zeros of a Complex Variable

I'm trying to plot the zeros within a certain distance from the origin using Mathematica of a given function (in my case, partial sums of the Zeta Function). I've tried plugging in simple functions, such as 1+2^(-s), but the program keeps throwing an error (it won't even show a plot). I am a beginner with Mathematica; will someone explain how to perform the task at hand or point me to some examples? I've found a few references, but they all seemed centered around learning the programming language as a whole. If possible, I want to avoid this for now and put it off until the summer when I'll have more time to sit down and play with it.


Aligning plot axes in a graphics object

I need to align the y-axes in the plots below. I think I'm going to have to do some rasterizing and searching for vertical lines, then vary `x` and `w`. Is there a better way?               a = ListPlot[{{0, 0}, {16, 20}},        PlotRange -> {{0, 16}, {0, 20}}, Frame -> True];     b = ListPlot[{{0, 0}, {160000, 200000}},         PlotRange -> {{0, 160000}, {0, 200000}}, Frame -> True];     x = 3.1; w = 5;     Graphics[{LightYellow, Rectangle[{0, 0}, {7, 8}],        Inset[a, {x, 5.5}, Center, {w, Automatic}],        Inset[b, {3.1, 2.2}, Center, {5, Automatic}]},       PlotRange -> {{0, 7}, {0, 8}}, ImageSize -> 300]      ![enter image description here](http://i.stack.imgur.com/KdCcn.png)


Weather Maps with Mathematica

I've been trying to set up a weather map with Mathematica similar to what NOAA publishes in their website. ![enter image description here](http://i.stack.imgur.com/rNAVN.png) So far I've been successful to bring the data over and extend it across the whole picture frame.                          weatherMap[region_, property_] :=               Module[{polygon, coord, minX, maxX, minY, maxY, data, deltaX, deltaY},                    polygon = CountryData[region, "Polygon"];               coord = Cases[CountryData[region, "Coordinates"], {_, _}, Infinity];               minX = Floor@Min[coord[[All, 2]]];               maxX = Ceiling@Max[coord[[All, 2]]];               minY = Floor@Min[coord[[All, 1]]];               maxY = Ceiling@Max[coord[[All, 1]]];               deltaX = (maxX - minX)/25;               deltaY = (maxY - minY)/25;               data = DeleteCases[                 Flatten[Table[{x, y, WeatherData[{y, x}, property]}, {x, minX,                     maxX, deltaX}, {y, minY, maxY, deltaY}], 1], {x_,                   y_, _Missing}];               Show[Graphics[{Opacity[0], polygon}],                 ListContourPlot[data, Contours -> 10,                  ColorFunction -> "Temperature", InterpolationOrder -> 3,                  PlotLegends -> Placed[Automatic, Above],                  PerformanceGoal -> "Quality"],                 Graphics[{EdgeForm[Black], FaceForm[Opacity[0.01], GrayLevel[.1]],                   polygon}]]]        weatherMap["USA", "Temperature"]      ![enter image description here](http://i.stack.imgur.com/fXpwA.png) What would be the best way to limit the contour temperature graphic to within the frame of the given polygon?


equidistant solutions in Sequence Sums That Are Squares

In my demonstration "Sequence Sums That Are Squares" I demonstrate two "lines" of solutions (of infinite length) and ask whether someone can find one more line. I am looking forward to your solution. I did not find a third line of solutions.


Applying non-Affine transforms to 2D polygons with textures

I am trying to create a vanishing point perspective transformation of 2D polygons, for example transforming the red polygon into the blue polygon:               p1 = Polygon[{{0, 0}, {1, 0}, {1, 1}, {0, 1}}];     p2 = Polygon[{{0, 0}, {1, 0}, {0.55, 0.5}, {0.45, 0.5}}];     Graphics[{FaceForm[None], EdgeForm[Red], p1, EdgeForm[Blue], p2}]      ![Mathematica graphics](http://i.stack.imgur.com/qIZA5.png) I can find the transformation easily enough with `{err, tr} = FindGeometricTransform[First@p2, First@p1]`; however, since the transformation is not an affine mapping, it cannot be handled by `GeometricTransformation`. Instead, I need to transform the points that make up the polygon:               Graphics[{FaceForm[None], EdgeForm[Red], p1, EdgeForm[Blue], Polygon@tr@First@p1}]      All seems well. If I try to apply a texture to the transformed polygon, things get ugly:               vop = VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}};     Graphics[{Texture[ExampleData[{"Texture", "Bricks3"}]], EdgeForm[Red],       Polygon[tr@First@p1, vop]}]      ![Mathematica graphics](http://i.stack.imgur.com/rX3YQ.png) It appears that the internals of `Texture` can't handle the non-affine mapping very well, despite being able to handle affine transforms:               str = ShearingTransform[30 Degree, {1, 0}, {0, 1}]     Graphics[{Texture[ExampleData[{"Texture", "Bricks3"}]], EdgeForm[Red],        Polygon[str@First@p1, vop]}]      ![Mathematica graphics](http://i.stack.imgur.com/ScqlZ.png) A rather clunky way around this problem is to use `ImagePerspectiveTransformation`, which was mentioned previously as having the ability to map any type of transform (affine or not).               ipt = ImagePerspectiveTransformation[       ExampleData[{"Texture", "Bricks3"}], tr, Padding -> None]     Show[ipt,       Graphics[{FaceForm[None], EdgeForm[{Thick, Red}],         Polygon[First@ImageDimensions[ipt]*p2[[1]]]}], ImageSize -> 400]      ![Mathematica graphics](http://i.stack.imgur.com/iiXd4.png) This problem (I think) boils down to performing a non-affine transform to a texture, so I am wondering **how (or if) this might be done efficiently than to perform the ImagePerspectiveTransformation on the texture image first**?


NDSolve gives wrong results for "stiff system"

I have a physical problem in which I want to solve for `c[e]` as a function of `e`, where `c` is expected to be in the range from 0 to 1. I have a ODE to solve, which is `c'[e] == f[c[e], e]`, and `f[c[e], e]` is given by               (2.*10^-6 (-0.706288 - 3.24379*10^-9 e +           c[e] (0.767155 +              6.48758*10^-9 e + (-0.27 - 2.2833*10^-9 e) c[               e])))/((1.42066 - 1. c[e])^2 ((          e (-6.4542*10^-7 +              e (2.72905*10^-15 - 1.65436*10^-30 c[e])))/(-1.42066 +             1. c[e])^3 + (          1.11743*10^-30 e^2 (6.18655*10^8 + 1.42066 e +              c[e] (-6.71971*10^8 -                 2.84132 e + (2.365*10^8 + 1. e) c[e]))^2)/(1.42066 -             1. c[e])^4 + (1. + (1/((1.42066 - 1. c[e])^2))            e (0.000010341 + 2.37466*10^-14 e +                c[e] (-0.0000112321 -                   4.74932*10^-14 e + (3.95315*10^-6 + 1.67152*10^-14 e) c[                    e])))^2))      I use `NDSolve`,               g = NDSolve[{c'[e] == f[c[e], e], c[0] == 0}, c, {e, -150000, 0}]      but get a message > *NDSolve::ndsz: "At e == -120259., step size is effectively zero; > singularity or stiff system suspected." The result is an interpolating function. For `e` > -120258, the result is good. For example               Plot[Evaluate[c[e] /. g], {e, -120258, 0}]      gives ![enter image description here](http://i.stack.imgur.com/PsSYO.png) But if `e` = -120259, `c` instantly becomes order 10^15, which I know must be wrong. I also plot `f[c, e]` (as a surface, for all possible `c` and `e`) and `f[c[e], e]` (as a single curve) in 3D plot.               Show[       ParametricPlot3D[{c, e, f[c, e]}, {c, 0, 1}, {e, -150000, 0},          PlotRange -> {{0, 1}, {-150000, 0}, {-0.001, 0.001}}],        ParametricPlot3D[{c[e] /. g[[1]], e, f[c[e] /. g[[1]], e]}, {e, -120259, 0},          PlotStyle -> Red,          PlotRange -> {{0, 1}, {-150000, 0}, {-0.002, 0.002}}],        BoxRatios -> {1, 1, 1}]      gives ![enter image description here](http://i.stack.imgur.com/qJbKC.png) I see the surface is mostly smooth, but at a strip region the derivative values are quite unstable as in a "stiff system". When the solution curve enters that region it goes wrong. In this case, how can I get the correct result? Update: as suggested by @Nasser, source codes are provided below               s11t = 7.4*10^(-12);     s33t = 13.1*10^(-12);     s12t = -1.4*10^(-12);     s13t = -4.4*10^(-12);     s44t = 16.4*10^(-12);     s66t = 7.6*10^(-12);     k11t = 4400*8.85*10^(-12);     k33t = 129*8.85*10^(-12);     d15t = 564*10^(-12);     d31t = -33.4*10^(-12);     d33t = 90*10^(-12);     M0 = {        {s11t, s12t, s13t, 0, 0, 0, 0, 0, d31t},        {s12t, s11t, s13t, 0, 0, 0, 0, 0, d31t},        {s13t, s13t, s33t, 0, 0, 0, 0, 0, d33t},        {0, 0, 0, s44t, 0, 0, 0, d15t, 0},        {0, 0, 0, 0, s44t, 0, d15t, 0, 0},        {0, 0, 0, 0, 0, s66t, 0, 0, 0},        {0, 0, 0, 0, d15t, 0, k11t, 0, 0},        {0, 0, 0, d15t, 0, 0, 0, k11t, 0},        {d31t, d31t, d33t, 0, 0, 0, 0, 0, k33t}        };     M1 = {        {s11t, s12t, s13t, 0, 0, 0, 0, 0, -d31t},        {s12t, s11t, s13t, 0, 0, 0, 0, 0, -d31t},        {s13t, s13t, s33t, 0, 0, 0, 0, 0, -d33t},        {0, 0, 0, s44t, 0, 0, 0, -d15t, 0},        {0, 0, 0, 0, s44t, 0, -d15t, 0, 0},        {0, 0, 0, 0, 0, s66t, 0, 0, 0},        {0, 0, 0, 0, -d15t, 0, k11t, 0, 0},        {0, 0, 0, -d15t, 0, 0, 0, k11t, 0},        {-d31t, -d31t, -d33t, 0, 0, 0, 0, 0, k33t}        };     I0 = IdentityMatrix[9];     L0 = Inverse[M0];     L1 = Inverse[M1];     s1111 = 1;     s1122 = L0[[1, 2]]/L0[[1, 1]];     s1133 = L0[[1, 3]]/L0[[1, 1]];     s1212 = 1/2;     s1313 = 1/2;     s1341 = -1/2*L0[[7, 5]]/(L0[[4, 4]]*M0[[7, 7]] + (L0[[7, 5]])^2);     s4242 = 1;     s4343 = 1;     S = {        {s1111, s1122, s1133, 0, 0, 0, 0, 0, 0},        {0, 0, 0, 0, 0, 0, 0, 0, 0},        {0, 0, 0, 0, 0, 0, 0, 0, 0},        {0, 0, 0, 0, 0, 0, 0, 0, 0},        {0, 0, 0, 0, 2 s1313, 0, 2 s1341, 0, 0},        {0, 0, 0, 0, 0, 2 s1212, 0, 0, 0},        {0, 0, 0, 0, 0, 0, 0, 0, 0},        {0, 0, 0, 0, 0, 0, 0, s4242, 0},        {0, 0, 0, 0, 0, 0, 0, 0, s4343}        };     B1 = Inverse[I0 + L0.(I0 - S).(M1 - M0)];     Q[c_] := Inverse[c*B1 + (1 - c)*I0];     A[c_] := (M1 - M0).B1.Q[c];     Bp1[c_] := I0 - (1 - c)*(M1 - M0).B1.Q[c].L0.(I0 - S)     Bp2[c_] := B1.Q[c];     Bp3[c_] := Transpose[Bp2[c]];     B[c_] := Bp1[c] + Bp3[c];     C2[c_] := -(1 - c)*B1.Q[c].L0.(I0 - S);     X[e_] := {0, 0, 0, 0, 0, 0, 0, 0, e};     Yds = {0, 0, 0, 0, 0, 0, 0, 0, -0.54};     Bf2[c_] := B1.Q[c].(B1 - I0).Q[c];     Bf3[c_] := Transpose[Bf2[c]];     Af[c_] := A[c] - c*(M1 - M0).B1.Q[c].(B1 - I0).Q[c];     Bf[c_] := B[c] + c*(-Bf3[c] + (M1 - M0).B1.Q[c].(I0 + (1 - c)*(B1 - I0).Q[c]).L0.(I0 - S));     Cf[c_] := C2[c] + c*(B1.Q[c].(I0 + (1 - c)*(B1 - I0).Q[c])).L0.(I0 - S);     fdriv[c_, e_] := 1/2 (X[e].Af[c].X[e] + X[e].Bf[c].Yds + Yds.Cf[c].Yds);     n = 2.0*10^(-6);     r1 = 6.83*10^4;     r2 = 1.08*10^6;     delpc[c_, e_] := D[fdriv[x, y], x] /. {x -> c, y -> e};     delpE[c_, e_] := D[fdriv[x, y], y] /. {x -> c, y -> e};     f[c_, e_] := FullSimplify[n*delpE[c, e]/((1 - fdriv[c, e]/r1)^2 + (fdriv[c, e]/r2)^2-n*delpc[c, e])];     g = NDSolve[{c'[e] == f[c[e], e], c[0] == 0}, c, {e, -150000, 0}]


Why Mathematica can't solve this? NSolve or Solve

_**I want solution of x and y which should be positive real numbers_**               Solve[2*(1 - a)*((x)^-n) + 2*a*((y)^-n) - 1 ==         0 && (1 - a)*((x)^(1 - n)) + a*((y)^(1 - n)) - 1 == 0 , {x, y}]      > During evaluation of In[2]:= Solve::ifun: Inverse functions are being used > by Solve, so some solutions may not be found; use Reduce for complete > solution information. >> > > During evaluation of In[2]:= Solve::svars: Equations may not give solutions > for all "solve" variables. >> > > Out[2]= {{y -> 2^(1/n) ((a x^n)/(-2 + 2 a + x^n))^(1/n)}} * ** _Supppose now I plug in certain numeric values n=0.3 a=0.6, it still can't solve it ._**               NSolve[2*(1 - 0.6)*((x)^-0.3) + 2*0.6*((y)^-0.3) - 1 ==         0 && (1 - 0.6)*((x)^(1 - 0.3)) + 0.6*((y)^(1 - 0.3)) - 1 == 0, {x,        y}, Reals]      > NSolve::ratnz: NSolve was unable to solve the system with inexact > coefficients. The answer was obtained by solving a corresponding exact > system and numericizing the result. >>


Data is imported as string instead of numbers

newdata = Import["data.txt", "TSV"];     ListPlot[newdata]      My `data.txt` file consists of two columns of numbers, separated by commas, like this:               1,4     2,5     3,5      and so on. When I look at how my `newdata` output seems to be fine (list of datapoints).               (* in  *) newdata     (* out *) {{1, 4}, {2, 5}, {3, 5}}      But, when I try the `ListPlot` command, I get just a blank graph at the origin with x and y's that range from 1. Can somebody help me with this type of graphing? Thanks in advance.


Strategies for simplifying complicated expressions

I have a very complicated expression involving trigonometric functions, complex numbers etc. You may find it here as it is too long to be pasted here. You may also find a screenshot of it here. **Assumptions:** All variables are real and strictly positive. This expression should be real! I'm dealing with this expression for days. Could someone tell me a strategy for simplifying it within Mathematica 8 ? More generaly, are there good tutorials or textbooks or lessons on strategies for simplifications? Perhaps is simplification a subjective concept? In my case it means more readable, and why not something that could fit in a research paper.


How to edit the text coming together with the numeration of pages in pdf produced out of a notebook?

I am writing a text that I am going to publish on-line. When I transform it from the notebook into the pdf format I get the numeration style typical for Mathematica: ![Mathematica graphics](http://i.stack.imgur.com/2WHPE.png) I would like to edit the text following the page numeration. For example, instead of "2|Supporting Materials 3.nb" I would like to leave either simple "2" or "2|Supporting materials". My question is: is it possible to edit this?


Evaluate Notebook from .Net

How is it possible to send the whole content of an existing notebook to _Mathematica_ for evaluation by using NetLink/C#?


Laplacian in D Dimensions

Is it possible to compute $\Delta F=\nabla^2 F$ for $F=F(x^1,x^2,…,x^D)$ with $D$ finite? I seem to be only able to specify spherical coorindates, for example, if I want to leave standard Cartesian coordinates. The function I'm actually using looks like this $F(x^1,x^2,…,x^D)=f^1(x^1)\times f^2(x^2) \times … \times f^D(x^D)$ (separation of variables). Is there a way mathematica can do this?


How to remove the 1. when differentiating 0.5x^2

My question is very basic, When using the Differentiate functionality of Mathematica in this way:               D[0.5 x^2, x]      This results in:               1.x      I don't need the 1. but how can I tell mathematica to remove this? It works further along in my code and gives me results like:               {{1. m, 0, 0}, {0, 1. m, 0}, {0, 0, 1. Jcm}}      Any ideas?


How do I get rid of the overlap of gridlines and tick mark labels?

I wish to include the plot generated by the following Mathematica code               Plot[1/Root[-3 - 8 #1 Tan[a/2] - 3 Tan[a/2]^2                    + #1^4 (1 + Tan[a/2]^2) + #1^2 (-9 + 3 Tan[a/2]^2) &, 2],       {a, 0, 2 Pi},       AxesOrigin -> {0, 0},        Ticks -> {{0, Pi/6, Pi/3, Pi/2, 2 Pi/3, 5 Pi/6, Pi, 7 Pi/6, 4 Pi/3,          3 Pi/2, 5 Pi/3, 11 Pi/6, 2 Pi}, {0, 0.125, 0.25, 0.375, 0.5,          0.625, 0.75, 0.875, 1, 1.125, 1.25, 1.375, 1.5}},        GridLines -> {{Pi/6, Pi/3, Pi/2, 2 Pi/3, 5 Pi/6, Pi, 7 Pi/6, 4 Pi/3,          3 Pi/2, 5 Pi/3, 11 Pi/6, 2 Pi}, {0, 1/8, 2/8, 3/8, 4/8, 5/8, 6/8,          7/8, 1, 9/8, 10/8, 11/8, 12/8}},        GridLinesStyle -> Directive[Dashed]]      > ![Mathematica graphics](http://i.stack.imgur.com/heVOV.png) in an article I'm writing. I don't like how the GridLines overlap the axis labels however. I searched around a bit for a solution but I'm no Mathematica expert and I can't work it out. Does anyone have a solution?


Methods for NonlinearModelFit

I am using `NonlinearModelFit` for a thesis project. I get quite different results if I change the Method to LevenbergMarquardt or QuasiNewton or ConjugateGradient and so on. My nonlinear model includes polynomials up to second order and a sigmoid function such as `ArcTan` or `Tanh`. I would like to know, which conditions Mathematica uses to choose the best algorithm if I set the `Method` as `Automatic`. It works sometimes, but most of the time it doesn't and I do not have the knowledge to say which method should be the best in my case. Just by trying out, I found `Gradient` and sometimes `ConjugateGradient` to work the best for my purpose. I also cannot find anywhere on the Internet which exact implementation of these methods is used inside Mathematica and how does it change the results. Here maybe an interesting link: Optimization Algorithms Thanks!


Efficiently finding the positions of a large list of targets in another, even larger list

I have a big list. It contains nearly 60,000 sub-lists. It's structured like               bigList = {{x1,y1,z1},{x2,y2,z2},{x3,y3,z3},.....,{x60000,y60000,z60000}};      I have picked 1200 elements from the `bigList` at random.               smallList = {{x1,y1,z1},{x2,y2,z2},......,{x1200,y1200,z1200}};      I want to find the positions of the `smallList` elements in the `bigList`. To that end I wrote the following code.               Flatten[Map[Position[bigList, #]&, smallList]]      It's working fine, but it takes **30 seconds** to evaluate.               Timing[Flatten[Map[Position[bigList, #]&, smallList]]]      How can I reduce that evaluation time?


What happened with the file?

What happened with this file?               infile = "\\test data.txt";            outstr = OpenWrite[infile];     instr = OpenRead[infile];     Read[instr, Record];     Close[instr];        All content of "test data.txt" was lost.


Can anyone explain this strange behavior of InputForm?

In Mathematica 9.0.0, when to display the input form of two numbers, I come across maybe a puny problem. In order to focus on the problem, I will put up a simplified version.               In[1]:=InputForm[E]            InputForm[Pi]      and the output is               Out[2]//InputForm=         Pi      The input form of `E` is eaten by the `Pi` one. Why would this happen? And if I add a semicolon to the later one, the input form of `E` will show up. And what's more, if I enter `InputForm` and `StandardForm` consecutively like this               In[7]:=InputForm[E]            StandardForm[Pi]      I get               Out[8]//StandardForm=         \[Pi]                E      the `E` being placed in a separate cell without the `InputForm` label. IMO, the output is made in the wrong sequence. So my question is, what does `InputForm` really do? Why does it "eat" the previous output?


Copy big or small values to LaTeX

When I create a DistributionFitTest of a distribution i receive very low P values. Eg. $2.456750213008007 \times 10^{-367}$. When I copy this (by right clicking and copy to LaTeX), and insert it in my LaTeX document, I receive the number as               \text{2.4567502130080068515188263453399491266$\grave{ }$15.778498511135323*${}^{\wedge}$-367}      Where I would prefer to receive a rounded value such as:               \text{2.457} \times 10^{-367}      Or at least receive an output equivalent, so that I don't have round up manually or edit "*" to "\times", or add up "10".


How can I impose a condition on Solve or FullSimplify?

I would like to define a real 3-D vector as, say, `v = {x, y, z}`, but I want it to have a fixed norm and not necessarily a unit norm. I would like to impose this condition on the vector `v` before I start using `v` in a calculation. In particular, I want _Mathematica_ to insert `x^2 + y^2 + z^2 = constant` during a calculation using `Solve` or `FullSimplify`. I have used `/. x^2 + y^2 + z^2 -> constant`, but this simply evaluates the result for the given constant. Is there way to impose my condition before/during the calculation.


Determining if a point is inside or outside a 3DS (.3ds) or 3DS MAX (.max) object?

Imagine I import some 3DS (i.e. 3D studio) file (http://reference.wolfram.com/mathematica/ref/format/3DS.html) or a 3DS MAX file. How could I place this model (say, the 747.3ds file in the Mathematica manual) in a scaled cloud of 3D points, then generate a list of points that are internal or external to this object? I would also settle for points being within a threshold distance of some feature in the mesh defining the object? As per Yves Klett's request (and hat tip to him for how to pull out a polygon list with triangle subcomponents) - what is the most efficient way to determine the set of points inside a list of polygons? I could perform a ray/triangle intersection test, for example, but is there some faster way using built-in routines in Mathematica 9? Is there something like InsidePolygonQ, perhaps using Delaunay triangulation? It looks like 3DS file polygons are convex (is this always true?), so that should simplify things. Running the import command:               Import["...\\test.3ds", "PolygonObjects"]      Yields a list of convex polygons of the form:               {Polygon[{{1.67293, 8.08139, 100.633}, {1.67267, 8.15993, 100.652}, {-0.0264846, 8.07622, 100.631}}], <<13099>>}      I would be very happy to have a function that would like me input one of these polyhedra and a test point, and determine if that test point is inside out outside the polyhedra.


User defined output forms

I have a mathematica program which performs some manipulation which I then want to continue in another language, as I already have some code written in it. Syntactically this language is very similar to `InputForm` and so I wanted to try and build my own output form based upon `InputForm` which would transform an expression into something understandable in this other language. The type of transformations would be things like swapping square brackets with parentheses, and renaming of functions. That is, a mapping like:               Den[x]*Den[y]+Den[x]*Den[z]  --> D(x)*D(y) + D(x)*D(z)      My naive attempts at doing something like this were to try and copy `InputForm` into `MyForm` and then try and apply various calls to Format, that is something like (just using the renaming in this example):               MyForm = InputForm;     Format[Den[x_], MyForm] := D[x];      But as MyForm is simply pointing towards InputForm, I have not managed to copy InputForm and so the Format calls to MyForm affect InputForm as well. At time of writing I do not have a complete list of the kind of output style transformations I wish to apply, but I am not looking for a complete solution, just an idea of how to get started with my own version of `InputForm` (without breaking the original). Any ideas on how to proceed would be appreciated. Thanks! Edit: eldo's answer has made me realise that there is a loophole in what I have written - All of my symbols/expressions already have StandardForm set up, and I don't want to break that either. That is, for example, I have:               Format[Den[x_], StandardForm] := 1/x^2;      In principle, this is why I'm looking to define a NEW output form, I don't want to get it tangled with any other that is already defined.


RSolve? How do I Solve these equations using Mathematica

How do I solve these using _Mathematica_? I'd like to have formula for `p[2]` to `p[n-1]`. `P[j]` is the general equation, `P[n]` is the last element, but finite `x[j]` is just some exogenous variables               p[j] == 0.5((p[j + 1] (x[j] - x[j - 1]))/(x[j + 1] -        x[j - 1]) + (p[j - 1] (x[j + 1] - x[j]))/(x[j + 1] -        x[j - 1]) + (x[j + 1] - x[j]) (x[j] - x[j - 1]))          p[1] == 0.5(p[2] + (x[1] + x[2]) (x[2] - x[1]))          p[n] == 0.5(p[n - 1] + (2 - x[n - 1] - x[n]) (x[n] - x[n - 1]))


Find white regions in image

At the white regions of this image I want to add a few random arrows. I would like to realize two different of adding the random arrows:   * The arrows may not leave the white region   * The arrows have to leave the white region -                img = Import["ExampleData/spikey2.png"]      ![enter image description here](http://i.stack.imgur.com/Sggh2.png) How can you do this with Mathematica? In particular I would like to know how to detect the white regions, and how to store this information. If I give you an arrow can you tell me whether it crosses non-white parts of the image? There is not much space for the arrows in this picture. It would be good to add a bit of white canvas to create some space for the arrows.


specifying a list (vector) of arbitrary length

When trying to do symbolic calculations in mathematica involving a space of dimension `n`, which is arbitrary but fixed, I'd often like to work with vectors that have arbitrary but fixed length `n`. So I'd like to have a vector defined like `vec = Array[v,n]`, which of course does only work if `n` has been initialized with an integer value before. I'd then like to apply some differential operators like let's say `D[vec,v[2]]`. Does anybody know an elegant way to do that (maybe using the new Inactive construct in Mathematica 10)? p.s.: Interestingly enough mathematica supports sums of arbitrary length, which for example enables the following kind of symbolic computation:               x /: D[x[i_], x[j_], NonConstants -> {x}] := KroneckerDelta[i, j];     D[Sum[x[i], {i, 1, n}], x[2], NonConstants -> x];      which yields the correct result: > Piecewise[{{1, n > 1}}, 0]


How can Mathematica solve 7 equations and want to find 7 variables

* I have 7 equations as below * e1 := (1 - a) p Subscript[A, 0] Subscript[s, K ] ! *SubsuperscriptBox[(s), (L), (-a)] = (1 - b) Subscript[B, 0] (1 - Subscript[s, K]) (1 - Subscript[s, L])^-b; e2 := a p Subscript[A, 0] ! *SubsuperscriptBox[(s), (L), (1 - a)] = b Subscript[B, 0] (1 - Subscript[s, L])^(1 - b); e3 := x = Subscript[A, 0] Subscript[s, K] ! *SubsuperscriptBox[(s), (L), (1 - a)]; e4 := [Pi] = R + [Delta] - (1 - Subscript[[Tau], y])/(1 + R Subscript[[Theta], i]) b Subscript[B, 0] (1 - Subscript[s, L])^(1 - b); e5 := [[Sigma] + [Phi] (1 - [Sigma])][ Subscript[B, 0] (1 - Subscript[s, K]) (1 - Subscript[s, L])^( 1 - b) - [Delta]] + [Rho] + [Pi] - R = 0; e6 := [Mu] - [Pi] - 1/Subscript[[Theta], i] (z - Subscript[[Theta], c] p x) + [Delta] = 0; e7 := [Gamma] = Subscript[B, 0] (1 - Subscript[s, K]) (1 - Subscript[s, L])^( 1 - b) - [Delta];   * some variable value* a = 0.35; b = 0.4; [Delta] = 0.1; Subscript[[Theta], c] = 0.65; \ Subscript[[Theta], i] = 0.15; [Phi] = 0.5; Subscript[[Tau], y] = \ 0.28; [Rho] = 0.01; [Mu] = 3.7; R = 0.047; Subscript[A, 0] = 0.4; Subscript[B, 0] = 1.99; [Sigma] = 1.1;   * how should I find the 7 vars: Subscript[s, L], Subscript[s, K], [Pi], x, p, z, [Gamma] ?*   * it's no response with below* Solve[{e1 == 0, e2 == 0, e3 == 0, e4 == 0, e5 == 0, e6 == 0, e7 == 0}, {Subscript[s, L], Subscript[s, K], [Pi], x, p, z, [Gamma]}]


ListPlot with conditions

I have a data file containing the position of about $10^5$ stars of a spiral galaxy. Here is the plot ![enter image description here](http://i.stack.imgur.com/L6Flj.jpg) and this is the corresponding code               Clear["Global`*"]     SetDirectory[" ... "];          data = Import["data_SGC.out", "Table"];     L0 = ListPlot[data, PlotStyle -> {Blue, PointSize[0.001]}, Axes -> False,                    Frame -> True, FrameLabel -> {"x", "y"},                    RotateLabel -> False, LabelStyle -> Directive[FontFamily -> "Helvetica", 20],                    AspectRatio -> 1, PlotRange -> 100, ImageSize -> 550];      As we can see, there are two arms starting at about $(x,y) = (-14.6,0)$ and $(x,y) = (14.6,0)$. Now I would like to customize `ListPLot`, so as the arm starting at the left part $(x,y) = (-14.6,0)$, be in green color, while the other one in red. All the other points between the two yellow banana-type areas should be in gray. Any suggestions? The complete data file can be found here: data. Obviously, I could not generate simple random data in order to replicate this complicated spiral structure.


How to get solution from DSolve

How to get the solution from DSolve in such way that there is no need to copy the result. When for example solving:               f[x_, y_] := a y + x^2      DSolve[{D[y[x], x] == f[x, y[x]], y[0] == c}, y[x], x]      I get the solution:               {{y[x] -> (-2 + 2 E^(a x) + a^3 c E^(a x) - 2 a x - a^2 x^2)/a^3}}      How can I make a function of this let's say sol[x] so I can use it in such context:               Manipulate[      Plot[sol[x], {x, 0, 5}], {a, -5, 5}, {c, -5, 5}]      EDIT: not interested in:               sol[x_, a_, c_] =       y[x] /. DSolve[{D[y[x], x] == f[x, y[x]], y[0] == c}, y[x], x]


DatabaseLink Example for DB2 and Mathematica

could someone please point me to good example on how to make a JDBC connection to an IBM DB2 database?


A question regarding 1 divided 243

Here is a problem due to Feynman. If you take 1 divided by 243 you get 0.004115226337 .... It goes a little cockeyed after 559 when you're carrying out the decimal expansion, but it soon straightens itself out and repreats itself nicely. Now I want to see how many times it repeats itself. Does it do this indefinitely, or does it stop after certain number of repititions? Can you write a simple _Mathematica_ program to verify one conjecture or the other?


Why do InputFields not respond in Manipulate utilizing FindGeometricTransform?

In the following code changing the `InputField` does not result in observing changes in a result from `FindGeometricTransform`, but moving the `Locator` does. This is related to a previous answer would seem to have a solution, but the fix from that solution doesn't fix the observed behavior, or rather, it causes other problems. Manipulate not working inside DialogInput In this Question/Answer, `LocalizeVariables` is set to `False` for the `Manipulate`, and the control in question is explicitly set as `Dynamic`. This then allows the `Manipulate` to respond appropriately. However, my FindGeometricTransform breaks when I try this. In playing around with the system, I think that I have found that the situation is actually a bit more subtle than I thought. Using Nasser's suggestion, moving the Manipulate to the outside of the Module does partially solve the problem. I can get the GeometricTransform to update whenever I change the fields. That would seem to solve the problem, however, it has a similar problem when I try to add data points to a table based upon the transform (my eventual goal). Here is a new function named maniTransform2 that illustrates the observed behavior.                   imageIUsed = ExampleData[{"TestImage", "Clock"}]         maniTransform2[image_] := Manipulate[Module[{func, points},             func =               Dynamic[FindGeometricTransform[{{coord1x, coord1y}, {coord2x,                    coord2y}}, {loc[[1]], loc[[2]]}][[2]]];             points =              If[Length[loc] > 2,                 Setting@func[loc[[3 ;; Length[loc]]]], {}];                  Row[{Show[{                 Image[image],                 Graphics[{Red, PointSize -> Large,                    Point[{{coord1x, coord1y}, {coord2x, coord2y}}]}]}],               func, Spacer[40],                Grid[Join[{{"X-coord", "Y-Coord"}}, points                 ]                ]               }]], {{loc, {{10, 10}, {20, 20}}}, Locator,              LocatorAutoCreate -> True}, {{coord1x, 50, "x-Position"},              InputField[#, Number] &}, {{coord1y, 50, "y-position"},              InputField[#, Number] &}, {{coord2x, 100, "x-Position"},              InputField[#, Number] &}, {{coord2y, 100, "y-position"},              InputField[#, Number] &}];              holderFunc := DynamicModule[{img = imageIUsed},           switcher =             Panel[TabView[{Dynamic[maniTransform2[img]], "Other Functions"}]];           DialogInput[Row[{Dynamic[switcher], InputField[Dynamic[img]]}]]]      So, calling `maniTransform2[imageIUsed]` directly, the `GeometricTransform` updates whenever I move one of the `Locator` points or if I change a value in one of the various `InputField`s. If I call `holderFunc`, then if I move any of the `Locator` points the `GeometricTranform2` updates. It also updates when I change one of the fields. When I add a Locator (command-Click on a Mac), the procedure adds it to the Table of points below the transform function. Whatever the values are in the input fields are frozen for the transform at that point. Changing the values in the input fields will change the transform function, but they won't change the values of the points in the Table. For that matter, the If statement in general is frozen. I.e. it needs to be wrapped in a Dynamic somehow. However, doing so then places the func into a Dynamic and since func is declared in the Module, this is a no-no and it turns red.


How to define an n-variate empirical distribution function probability for any n?

I'm using Mathematica 9.0 to calculate the probability according to the empirical distribution function (EDF) of some sample data. Afterwords this is included in a maximization stage so I define this probability as a function. I have to do apply this to groups of data in which each group has different dimensionality. Therefore I'd like to define a generic version of "probability given by an EDF" that I can apply to any of these groups. Here there is a toy example for some 2-dimensional samples:               data = Transpose[{{1, 3, 4, 9, 8, 7, 8}, {2, 1, 1, 6, 7, 8, 9}}];     MatrixForm[data]      Its EDF is simply:               edf := EmpiricalDistribution[data];      Then by hand one can easily define its probability function:                edfProbFunction[t1_, t2_] := NProbability[x1 <= t1 \[And] x2 <= t2, {x1, x2} \[Distributed] edf];      and compute the probability by just defining:               edfProb[w1_, w2_] := Evaluate[edfProbFunction[w1, w2]];      In this way, given a new point (2,4) from this distribution, it has probability 0.142857 given by:               edfProb[2,4]      My question is **how to define a function like _edfProbFunction_ for any dimension, not a fixed dimension** (2 in the example)? I tried to do it in different ways but didn't succeed. I lack background in Mathematica so these attempts may be nonesense. I summarize them anyway in case this can be of any help: **First naive attempt** -- use a vector of input variables, straightforward               edfProbFunction[t__] := NProbability[x <= t, x \[Distributed] edf];     edfProb[w__] := Evaluate[edfProbFunction[w]];      Using this definition of _edfProb_ together with the _edfProbFunction_ defined in the toy example works, but not with this _edfProbFunction_ here. This made me think that I had to somehow made explicit each of the individual predicates (the inequalities) in _edfProbFunction_ **Second attempt** -- use MakeBoxes But a simple example shows that the expressions produced by this are not seen as variables in _edfProbFunction_ :               xP /: MakeBoxes[xP[x___], form_] := RowBox[Riffle[Map[MakeBoxes[#, form] &, {x}], ","]]     x[1] = "" <> {"x", IntegerString[1]};     x[2] = "" <> {"x", IntegerString[2]};     varx = xP[x[1],x[2]] (*this produces a list x1,x2 *)     edfProbFunction[t1_,t2_] := NProbability[x1 <= t1 \[And] x2 <= t2, {varx} \[Distributed] edf];      **Third attempt** -- I tried to define a function that recursively creates the predicate, but it doesn't work neither:               table = Table[x[i] <= t[i], {i, 2}];     g[n_] := If[Length[n] > 1, n[[1]] \[And] g[Drop[n, 1]], If[Length[n] == 1, n[[1]], 0]]     predicate = g[table]     edfProbFunction[t_] := NProbability[predicate, {t[1], t[2]} \[Distributed] edf];     edfProb[w__] := Evaluate[edfProbFunction[w]];     edfProb[{2, 4}]      Any suggestions will be welcome, specially complete answers to my question.


Copy and paste behaviour with Subscript

I tend to use a lot of subscripts in my code, and I am aware that copy and paste of subscripts from Mathematica to MathematicaSE (or any text editor, for that matter) is screwy in the sense that $a_b$ copies to MathematicaSE as               Subscript[a, b]      which when pasted back into Mathematica yields `Subscript[a, b]`. This is quite different behavior than Greek or other special symbols; for example, $\Lambda$ copies into MathematicaSE as               \[CapitalLambda]      which when pasted back into Mathematica correctly yields $\Lambda$. The same applies even for more obscure symbols, like `\\[WhiteBishop]`. Is there any way at all to have subscripts correctly copy and paste from notebook to text to notebook like all the other special symbols in Mathematica? Or is there no choice but to use infix symbols, like `a[b]`?


How to stop a ParametricPlot3D from autorotating

The 3d graphic functions like `ParametricPlot3D` and `ContourPlot3D` always give me a rotating plot. Sometimes, I even can't stop it rotating when I select the plot. For example, I am getting autorotation, like an animation, from               ParametricPlot3D[{Sin[a] Cos[b], 2 Sin[a] Sin[b], 3 Cos[a]},        {a, 0, π}, {b, 0, 2 π}, BoxRatios -> Automatic]


Create a "perspective animation"

Inspired by How can this confetti code be improved to include shadows and gravity? I would like to create my new experiment/stimuli using Mathematica. The idea is to study how people move their eyes in a dynamic scene. To do so I need to build some animations (1 minute long to start) where we feel like going forward in a perspective grid like the one below. ![enter image description here](http://i.stack.imgur.com/ZGtaT.png) I will need to make some object appear/disappear/change within that scene. The grid itself could just be made out of point, and i will add some geometric colored shapes. While I know how to draw perspective I don`t know how i could "program" it and then animate it.


Drawing Rotated views while ignoring the Bounding box

I am trying to make an animation of a rotating cube using the following code:               cube = GraphicsComplex[     {{0, 0, 0}, {0, 0, 1}, {0, 1, 0}, {0, 1, 1}, {1, 0, 0}, {1, 0, 1}, {1, 1, 0}, {1, 1, 1}},     Polygon[{{1, 2, 4, 3}, {5, 6, 8, 7}, {1, 2, 6, 5}, {3, 4, 8, 7}, {1, 3, 7, 5}, {2, 4, 8, 6}}]     ]          cubes = Table[     Graphics3D[{Rotate[cube, x, {1, 1, 1}, {0, 0, 0}]},      ViewPoint -> {3, 1/2, -2}, ViewVertical -> {1, 1, 1},      Boxed -> False], {x, 0, 2 Pi/3 - Pi/48, Pi/24}]      However, as the cube rotates, the bounding box (which is not drawn because `Boxed->False`) causes the image of the cube to be shrunk to fit the larger bounding box in the field of view. Is there a way to keep the scale constant and not vary with the varying size of the bounding box? I've gone through the list of options for `Graphics3D`, yet none seem to help. * * * **Edit:** Heike's answer works like a charm! For those interested, here is the finished code, used to create the illustration for this answer on math.SE.               cube =     GraphicsComplex[     {{0, 0, 0}, {0, 0, 1}, {0, 1, 0}, {0, 1, 1}, {1, 0, 0}, {1, 0, 1}, {1, 1, 0}, {1, 1, 1}},     Polygon[{{1, 2, 4, 3}, {5, 6, 8, 7}, {1, 2, 6, 5}, {3, 4, 8, 7}, {1, 3, 7, 5}, {2, 4, 8, 6}}]     ];          envelope[t_] := If[t < 1, t, If[t < 2, Sqrt[(2 t - 3)^2 + 3]/2, 3 - t]]          lozenge =      Rotate[     RevolutionPlot3D[{Sqrt[2/3] envelope[t], t/Sqrt[3]}, {t, 0, 3}, MaxRecursion -> 5][[1]],     {{0, 0, 1}, {1, 1, 1}}];          enveloped =      Table[     Graphics3D[{Rotate[cube, x, {1, 1, 1}, {0, 0, 0}],  Opacity[1/2], lozenge},     ViewVector -> {3, 1/2, -2}, ViewAngle -> 30 Degree, ViewCenter -> {1/2, 1/2, 1/2},      ViewVertical -> {1, 1, 1}, Boxed -> False, ImageSize -> 300],     {x, 0, 2 Pi/3 - Pi/48, Pi/24}];          Export["enveloped.gif", enveloped, "GraphicsList", "DisplayDurations" -> {.05}]


Opening a context menu (with the Menu key)

Is it by any chance possible to make the Menu key work as one would expect in _Mathematica_ : opening a context menu? The Menu key does nothing in version 7 or 8 on Windows.


how to extract a subinterval from a previous element in a list (in condition)

**question:** i need to use mathematica to write an intermediate value theorem's algorithm, but i don't know how to write in a module form... i have a function and then, we need to set up a range and also its stepsize... **example:** f(x)=8x-12x^2+4x^3 range=[-0.5,3.5] stepsize=1 thus, x={-0.5,0.5,1.5,2.5,3.5 } compute f(-0.5),f(0.5),f(1.5),f(2.5),f(3.5) a series of element will showed y={-7.5,1.5,-1.5.7.5,52.5} **condition:** an interval of x will be choose when it consists a -ve value and follow by a +ve value in its function value. **result:** since {-7.5,1.5} and {-1.5,7.5} hence subinterval[-0.5,0.5]and [-1.5,7.5] selected. **question (cont)** random choose a value from interval(s) selected and run a newton method step x[n+1]=x(n)-(f[x(n)]/f'x(n)]


How to copy groups of cells with NotebookWrite?

I'm trying to use:               NotebookWrite[nb, NotebookRead[EvaluationNotebook[]];      to copy cells from the `EvaluationNotebook[]` to a new notebook `nb`. For this, I move around in the `EvaluationNotebook[]` using different applications of `SelectionMove[nb, ...]`. Now, I would like to copy the exact same cell groupings of the current document as well, and this doesn't seem to happen. In the newly created notebook `nb`, I just see consecutive cells, without any grouping. Why is that? how can copying of groups be achieved? All help very much appreciated!


Can I place a link to a package file (.m) in my Applications folder

I am developing a package and would like to be able to test it without having to copy the package file to my `$UserBaseDirectory/Applications` folder for each change, so it would be convenient for me to just create a Finder link or symlink pointing back to my working file. So far I have not been able to convince Mathematica to treat the link as a package file. Am I missing a subtle technique that may make this possible?


Sum[expr,{i,0,Infinity}] for power series of cumulative normal distribution gives exponential function?

The Taylor series (about 0) for the cumulative normal distribution has coefficients:               g[i_] := Piecewise[{{Sqrt[Pi/2], i == 0}, {(-1/2)^((i - 1)/2)/(((i - 1)/2)!*i), Mod[i, 2] == 1}}]/Sqrt[2*Pi]      However,               Sum[g[i]*x^i,{i,0,Infinity}]      gives $e^x$ and not the $\frac{1}{2} + \frac{1}{2} Erf(\frac{x}{\sqrt{2}})$ expected. When I               Plot[Sum[g[i]*x^i, {i, 0, 20}], {x, -5, 5}]      I get something looking like an exponential (not expected). But when I               Plot[Evaluate[Sum[g[i]*x^i, {i, 0, 20}]], {x, -5, 5}]      I get something looking like the cumulative normal distribution (expected). Trying to understand the different plots, I looked at               {Limit[Sum[g[i]*x^i, {i, 0, n}], n -> 3], Sum[g[i]*x^i, {i, 0, 3}]}      Which gave $\left\{\frac{e^x \Gamma (4,x)}{6},-\frac{x^3}{6 \sqrt{2 \pi }}+\frac{x}{\sqrt{2 \pi }}+\frac{1}{2}\right\}$ - the choice of n=3 is just for tidiness, similar results hold for all n (that I tried). These are clearly not equal as substituting $x\to 0$ gives $\{1,\frac{1}{2}\}$. This, presumably, explains why I am getting the incorrect answer for the infinite sum and different plot results depending on the placement of the evaluate. Is there an explanation as to why I get different results with/without the limit and how to work around it (in the infinite sum case)? The motivation is that I am trying to combine these coefficients in other infinite sums (corresponding to cumulative distribution of a sum of Gaussians centered at different positions) and it is giving results that differ from the series expansion I otherwise would obtain (using Series). The above was tested on Mathematica 9.01 on Linux. **EDIT** Turns out that the sum doesn't evaluate on Mathematica 9.01, there was traces of previous definitions lying around that caused it to evaluate when it shouldn't have. Solution is to avoid the piecewise definition and explicitly only sum the odd terms.


How to export a 16 or 32 bit TIFF file

I have a function that creates a monochrome grayscale image that must be export as a 16-bit and 32-bit TIFF file. The _Mathematica_ documentation mentions that these bit depths are supported during `Export`, but makes no reference as to how to specify them under TIFF or `Export`. How is the bit depth specified for this type of export?


Converting polar coordinate expression to cartesian coordinates

An intermediate step in my analysis requires me to work in polar coordinates, but I would like to convert the results back into cartesian coordinates. The conversion is very simple but tedious for complex expressions. I expected to use substitutions, but it isn't panning out for me               polarf[{r_, phi_}] := r^6 Sin[phi]^2 Cos[phi]^2     cartesianf[{k1_, k2_}] :=       polarf[{r, phi}] /. r^2 Sin[phi]^2 -> k2^2 /.         r^2 Cos[phi]^2 -> k1^2 /. r^2 -> k1^2 + k2^2     cartesianf[{k1, k2}]      gives me back my original expression:               r^6 Cos[phi]^2 Sin[phi]^2      I'm pretty sure there is a way to get Mathematica to spit out               (k1^2 + k2^2) k1^2 k2^2      or something similar. But how? My searches of Google, Mathematica documentation, and this site have not turned up an answer.


Add elements in a sublist

I have created a subset of arrays:               b = Subsets[Range[10], {5}]     (* Out= {{1, 2, 3, 4, 5}, {1, 2, 3, 4, 6}, {1, 2, 3, 4, 7}, {1, 2, 3, 4, 8},              {1, 2, 3, 4, 9}, ..., {6, 7, 8, 9, 10}} *)      This command shows the combinations I wish to evaluate with. How can I add the elements of each subset in the list above to get an output like:               {{15}, {16}, {17}, {18}, {19},..., {40}}


Second-Order Feedback Pathways

I'm relatively new to Mathematica and I've tried searching and reading through the Mathematica documentation but I'm not able to find a good place to start. I want to model a simple, second-order negative feedback loop between two parties. I would like a) to have a visual animation of the system (this can be crude) and b) for there to be a plot of the amount of each party there is over time (this should obviously be some sort of periodic function depending on the parameters of the system). Finally, I want to be able to see the change in behavior as a function of the delay in response of party A from party B. If the delay is long it should take a long while for equilibrium to occur after a shock. A lot of the specific functionality I've mentioned is something I'm willing to try and figure out later, I just want a good place to start learning how to model such a system. Thanks!


Efficient Dyson series implementation

I'm trying to implement a Dyson series \begin{array}{lcl} U(x,x_0) & = & 1 + \int_{x_0}^{x}{dy_1V(y_1)}+\int_{x_0}^x{dy_1\int_{x_0}^{y_1}{dy_2V(y_1)V(y_2)}}+\cdots \\ & &{} + \int_{x_0}^x{dy_1\int_{x_0}^{y_1}{dy_2 \cdots \int_{x_0}^{y_{n-1}}{dy_nV(y_1)V(y_2) \cdots V(y_n)}}} +\cdots \end{array} where $V(x)$ is a large matrix. (I'm aware of the solution for symmetric functions, it doesn't work in my case.) Probably the main bottleneck is the integration but, since it involves multiple integrals, I don't see any easy way of dealing with it. Compile seems to be out of reach as well. I'll greatly appreciate any kind of advice. Here's the code I've written so far:               myInt[exp_, x1_, rat_] :=       Module[{mulInt, len, int, sum, s1, s2, rar, x, x2 = rat x1, r2,         r1},       SetAttributes[x, NHoldFirst];       (*to prevent switching into numerical values*)            mulInt[y1_, y2_, n_Integer /; n > 0] := Module[{tab},         tab = Table[{x[i], y1, x[i - 1]}, {i, 1, n - 1, 1}];         Return@Prepend[tab, {x[0], y1, y2}]         ];       (*mulInt creates lists of variables to be integrated*)            int[n_] :=         Integrate[Dot @@ (#1 /@ #2[[;; , 1]]), Sequence @@ #2] &[exp[#] &,          mulInt[x1, x2, n]];       (*maps first elements of mulInt's lists as variables of exp,        creates a matrix product out of all exps*)            sum[n_] := Module[{set},         set = Sum[int[m], {m, 1, n}];         len = Length[set[[1]]];         Return[IdentityMatrix[len] + set]         ];       (*Dyson series*)            s1 = sum[3];       rar = Total[Abs@Flatten[#]] &;       r1 = rar[s1];       (*a function for convergence check*)       Do[s2 = s1 + int[n];        r2 = rar[s2];         Print[{n, r2 - r1}];         If[Abs[r2 - r1] <= 10^-3. len^2, Break[]]; s1 = s2;         r1 = r2;, {n, 4, 15}];       (*convergence test*)            Return[s2]       ]      Here's a simple example with the 3rd Pauli matrix:               MatrixExp[Integrate[PauliMatrix[3], {x, 1., 2.}]]     myInt[PauliMatrix[3] &, 1., 2.]     (*results:     {{2.718282, 0.}, {0., 0.3678794}}     {{2.716667, 0}, {0, 0.3666667}}     *)      Of course, `MatrixExp[Integrate[function, {x, 1., 2.}]]` does not work in more general cases. The operators I work with are sparse arrays (code below) and it take ages to get the result. Typical values of `M`: 10 to 20 (`M=2` can be a good working example). To run the code, type for instance `myInt[toMT[ #, 2]& , 10^-7, 2.]`.               toMT[x_, M_] :=       Module[{nMax = 8 M + 4, sw, ret, v = 0.1, t = 5 10^8., ntol, mrul},       ntol[nn_, Mn_] := Mn - (Ceiling[nn/4] - 1.);     mrul[n_, m_, y_] := {n, m} -> y;            sw[n_] :=         Switch[{Mod[n, 4], n + 12 <= nMax, n + 15 <= nMax, n - 12 >= 1},         {1, True, True, _},         {mrul[n, n, -ntol[n, M] /x],          mrul[n, n + 12, I v  t],          mrul[n, n + 15, 2 v   (ntol[n, M] - 2) /x]},              {1, True, False, _},         {mrul[n, n, -ntol[n, M] /x],          mrul[n, n + 12, I v  t]},              {1, False, _, _},         {mrul[n, n, -ntol[n, M] /x]},              {2, _, _, _},         {mrul[n, n, (ntol[n, M] - 1) /x],          mrul[n, n + 1, -I t ]},              {3, _, _, True},         {mrul[n, n, ntol[n, M] /x],          mrul[n, n - 12, I t v  ],          mrul[n, n - 13, -2 v  (ntol[n, M] + 2) /x]},              {3, _, _, False},         {mrul[n, n, ntol[n, M] /x]},              {0, _, _, _},         {mrul[n, n, -(ntol[n, M] + 1) /x],          mrul[n, n - 3, -I t ]}         ];       ret = Map[sw[#] &, Range[1, 8 M + 4]];       Return[SparseArray@Flatten[ret]]]