Initialization Time Out (Weighted Financial Data)

I've been playing with `WeightedData` and wanted a financial engineering example, a colleague suggested working with the fractional return (`FinancialData["Name","FractionalChange"`) of a weighted portfolio. Things were going well until I tried to build a `Manipulate`:               Manipulate[     Grid[     {{Style[DateString[fractionalChanges[[1, day, 1]], {"DayName", " ", "Day", " ",         "MonthName", " ", "Year"}], "Text"], SpanFromLeft},     {Style["Unweighted Mean Fractional Change:", "Text"],      Style[ToString@Mean[fractionalChanges[[All, day, 2]]], "Text"]},     {Style["Weighted Mean Fractional Change:", "Text"],      Style[ToString@Mean[allWeightedFChanges[[day]]], "Text"]},     {Pane[      Plot[{PDF[HistogramDistribution[allWeightedFChanges[[day]], 10],          x], PDF[HistogramDistribution[          allWeightedFChanges[[day]]["InputData"], 10], x]}, {x, -0.03,         0.03}, Filling -> Axis, PlotStyle -> {Red, Blue},       PlotLegends -> {"Weighted Fractional \nChange Distribution",          "Unweighted Fractional \nChange Distribution"},        AxesLabel -> {"Fractional Change", " "}], {700, 280},       ImageSizeAction -> "ResizeToFit", Alignment -> {Center, Center}],      SpanFromLeft}}, Frame -> All], {day, 1, 253, 1},     Initialization :> (thirtyRandomStocks =      RandomChoice[FinancialData["FTSE100", "Members"], 30];     fractionalChanges =      Chop@Map[FinancialData[#, "FractionalChange", DatePlus[-360]] &,        thirtyRandomStocks];     stockWeights = RandomInteger[{100, 10000}, 30];     allFChange = fractionalChanges[[All, All, 2]];     allWeightedFChanges =      Table[WeightedData[allFChange[[All, i]], stockWeights], {i, 1,        Min[Table[         Length[allFChange[[i, All]]], {i, 1,           Length[allFChange]}]]}];)]      I get an "Initialization Time Out" error and can't figure out how to give the `Manipulate` more time to initialise. Therefore, I have two questions:   * How can I give Mathematica more time to initialise, or else ensure the `Manipulate` gets the necessary data for the calculations?   * Note: This `Manipulate` will always be used within notebooks, so Free CDF limitations aren't important for me at this point.   * Are there any suggestions you'd be willing to share to improve the code in general? I'm aware that if you look closely I'm not working with the data correctly; `allWeightedFChanges` doesn't really do what it should do.


Making mathematical animations with Mathematica

I recently stumbled upon the Cycloid and was working on finding its length and such when I found this animation on Wikipedia. ![](http://upload.wikimedia.org/wikipedia/commons/6/69/Cycloid_f.gif) Strikingly pretty and small in size too (66KB) So on searching how he made that particular animation and others I stumbled upon this talk > What software edited the animations? > > ... None at all. I used MSVC++ to write a little program that calls some > GDI+ functions and draws a multi-layer TIF picture each layer of which is a > single frame (Only Math, C++ & some Windows API that are well-documented). > ... I went on searching libraries to program with but ultimately quit because it was too much of a bother. Somewhile later I saw this and thank goodness the author used a software package (MuPAD). But the software costs a lot and is now part of MATLAB, and the size of the `.gif` was way too large. Finally I've come back to Mathematica and want to know how to go about it. Don't just tell me the code right away; give me some pointers, text, documentation, other questions, etc. EDIT : Thank you people, here's my rendering (not exactly, because I used J.M.'s code) ![](http://i.stack.imgur.com/xTRNt.gif)


Writing a function that returns a (usable) function

I am trying to create a function that returns Arnold's Cat Map of size _n_ iterated _k_ times. I can get something out of the `Function` command, but I can't figure out how to use that output as a function. The non-iterated version of the problem is trivial. I define my mapping function:               G[x_, y_, n_] := Mod[{{2, 1}, {1, 1}}.{x, y}, n];      I want it to work with `ImageTransformation`, so I define an appropriate function for that:               CatMapStep[{x_, y_}] := G[x, y, side];      where `side` is calculated somewhere earlier. Now I can call ImageTransformation (let's say I have an image `kitty`):               ImageTransformation[kitty, CatMapStep]      Done. But what do I do if you want to iterate CatMap _k_ times? Well, I can hard-code k:               CatMapFiveTimes[u_] := Nest[CatMapStep[u], u, 5];      And I discovered the `Function' command, but I can't figure out how to use it. What I would _really_ like to do is create a function that takes _k_ as an argument, and returns a function of _u_. Such is the sentiment of the following **incorrect** snippet:               IteratedCatMap[k_] := Function[u, Nest[CatMapStep[u], u, k];   <--- DOESN'T WORK      In my fantasy world, I would then be able to define CatMapFiveTimes by invoking the following line:               CatMapFiveTimes[u_] = IteratedCatMap[5];     <--- HYPOTHETICAL      And then using it as I would the previous definition. How can I create this function that returns a function? Thanks, David PS: Note that I am using Mathematica 8, although my officemate has Mathematica 9 and she couldn't get it, either. PPS: I am _completely_ open to a totally different approach to this problem. Ultimately, my only goal is to use `Manipulate` to let my students specify how many iterations of the cat map they want to see. I will be doing similar things for the Mandelbrot set, as well.


Underlying Algorithms for List Manipulation Functions

Does anyone know, or know of a link for the underlying algorithms used for list manipulation functions? Specifically:   * `Union` with and without the `SameTest` option   * `DeleteDuplicates` with and without a _test_ function.    * `Gather` with and without a _test_ function   * `Sort` with and without an _ordering function_ This question came about as there has been numerous questions that have asked about removing duplicates or some other list manipulation function. Some of the best answers often included usage of `GatherBy` due to the performance it offers (a few hundred times over `DeleteDuplicates` in some cases). Related: usages of `GatherBy` and `Union`:   Checking for duplicates in sublists `GatherBy`   Ordering function with recognition of duplicates `GatherBy`   Gather list elements by index `GatherBy`   Retrieving duplicates from nested list `GatherBy`   Delete duplicates in a list, depending on the sequence of numbers `Union`   How to delete duplicate solutions of this system of equations? `Union`


Mathematica quits calculation automatically

I have this little program that is adopted from a Wolfram demonstrations project (link here: http://demonstrations.wolfram.com/PercolationOnASquareGrid/). I want to see what happen if I increase the matrix size to 1000 or even above but Mathematica quits me. If I made the change inside Manipulate, it just showed "Manipulate Aborted". If it is without Manipulate, it quits the Kernel. I don't if it there is a glitch in my version (9.00) or simply because the limit of Mathematica... Thanks a lot for your time!!               h = 1000;     p = 0.59;          Block[{a, $RecursionLimit = 25000, w = h},       per[{i_, j_}] :=        If[1 <= i <= w && 1 <= j <= h && a[[i, j]] == 1, a[[i, j]] = 2;        per[{i, j} + #] & /@ {{1, 0}, {0, 1}, {-1, 0}, {0, -1}}];      SeedRandom[2424];      a = Map[Boole[# < p] &, RandomReal[{0, 1}, {w, h}], {2}];      a[[All, 1]] = a[[All, h]] = 1; Do[per[{i, 1}]; per[{i, h}], {i, w}];      ArrayPlot[Transpose[a], ImageSize -> 1000, Mesh -> True,        ColorRules -> {0 -> White, 1 -> Darker[Blue], 2 -> Red}]]      Another piece that doesn't work:               L = 1000;     p1 = 0.6;     seed = 2000;          perColation[{i_, j_}] :=            If[1 <= i <= L && 1 <= j <= L && a[[i, j]] == 1,        a[[i, j]] = 2;        perColation[{i + 1, j}];        perColation[{i - 1, j}];        perColation[{i, j + 1}];        perColation[{i, j - 1}];        ];          SeedRandom[seed];          Block[{a, $RecursionLimit = Infinity},      a = RandomReal[{0, 1}, {L, L}];      For[j = 1, j <= L, j++,       For[i = 1, i <= L, i++,        If[a[[i, j]] < p1,         a[[i, j]] = 1,         a[[i, j]] = 0         ]]];           a[[IntegerPart[L/2], IntegerPart[L/2]]] = 1;      perColation[{IntegerPart[L/2], IntegerPart[L/2]}];      ArrayPlot[Transpose[a], ImageSize -> 1000,        ColorRules -> {0 -> White, 1 -> White, 2 -> Red}]]


TreePlot, VertexRenderingFunction and stretched vertices issue

Recently I found the following `TreePlot` issue. For simplicity, I took an example from Mathematica Tree Drawing Tutorial and set `TreePlot` orientation to `Left`:               TreePlot[{1 -> 4, 1 -> 5, 2 -> 8, 3 -> 4, 4 -> 8, 6 -> 8, 7 -> 8, 7 -> 9}, Left,         VertexRenderingFunction -> ({EdgeForm[Black], Yellow, Disk[#1, 0.2],              Black, Text[#2, #1]} &)]      ![TreePlot with Left orientation](http://i.stack.imgur.com/Cn0qA.png) But when I specified the root node to `5` (which differs from an automatically selected root node `4`), I recieved an image with stretched verticies:               TreePlot[{1 -> 4, 1 -> 5, 2 -> 8, 3 -> 4, 4 -> 8, 6 -> 8, 7 -> 8, 7 -> 9}, Left, 5,         VertexRenderingFunction -> ({EdgeForm[Black], Yellow, Disk[#1, 0.2],              Black, Text[#2, #1]} &)]      ![TreePlot with Left orientation and root node 5](http://i.stack.imgur.com/ihcWe.png) Is there a generic solution to this problem? Thanks.


Identifying when two graphic objects overlap

I'm designing a small demonstration that helps to visualize the reason behind shaping an electrode that is used to probe a surface:               tip[rg_] := {EdgeForm[Thin], FaceForm[White],Polygon[{{0, 4}, {0, 0.2},        {0.5 - rg, 0}, {0.5 + rg, 0}, {1, 0.2}, {1, 4}}],        FaceForm[Black], Rectangle[{0.4, 0}, {0.6, 1}]};     box = {EdgeForm[Thin], FaceForm[Blue], Rectangle[{-3, -1}, {3, 3}]};     surface = {FaceForm[Green],        Polygon@Partition[Flatten@{{-3, -1}, {3, -1},            Table[             BezierFunction[{{-3, 0}, {0, 1}, {2, -1}, {3, 0}}][x], {x, 1,               0, -0.05}]}, 2]};     Manipulate[Graphics[{box, surface, GeometricTransformation[         GeometricTransformation[tip[rg], TranslationTransform[{a, b}]],         RotationTransform[t Degree, 0.5 + {a, b}]]},        PlotRange -> {{-3, 3.1}, {-1.1, 3}}],      {{a, 0, "Left/Right"}, -3, 2}, {{b, 2, "Up/Down"}, -0.5,        2}, {{t, 0, "UME tilt"}, -15,        15}, {{rg, 0.4, "UME sharpness"}, 0.11, 0.5}]      ![Mathematica graphics](http://i.stack.imgur.com/HLRG6.png) I would like the demonstration to show some type of visualization (perhaps just a big red "CRASH warning" text) whenever the tip graphic is positioned below the surface graphic, but I do not know how to construct a conditional statement that compares the multiple points in each graphic object. I'm happy to alter the structure of either the surface or tip objects if that makes the problem easier to solve.


How to select TransformationFunctions based on Assumptions made when using Simplify?

I am re-writing the question using a very simple example so not to confuse matters with the another question being asked where I used the example from there. In general, how to add logic to switch between one `TransformationFunctions` or another inside `Simplify` or any function that uses `TransformationFunctions`? For example,               ClearAll[n, tf, e, cf];     cf[e_] := LeafCount@e     tfForIntegerOnly[e_] := If[MatchQ[e, 2 n], n, e]     tfForRealOnly[e_] := If[MatchQ[e, 2 n], n^2, e]          Assuming[Element[n, Integers],       Simplify[2 n, TransformationFunctions -> {Automatic, tf}, ComplexityFunction -> cf]]      How to make it use `tfForIntegerOnly` when `Element[n, Integers]` and use `tfForRealOnly` when `Element[n, Reals]` **Where to add this logic**? How to pass the assumptions around or check for it and what it contains? Since Mathematica does not have types (in traditional sense) associated or attached with the symbols themselves (other than looking at Head, which in this case provides no information), one needs a general way to handle this. ## Original question below I'd like to simplify an expression under one set of assumptions using one `TransformationFunctions` function and use another `TransformationFunctions` function (or use `Automatic`) for different set of assumptions. The problem is that the `TransformationFunctions` itself has no access to these `Assumptions` used before in calling `Simplify` and hence it is hard to find a way to add logic to detect which assumptions is used at that level. To explain, I want to apply `TransformationFunctions` to transform `Gamma[1/2 + n]` to `Sqrt[Pi] (Factorial2[2 *(n - 1/2) - 1])/2^(n - 1/2)` but only when `Element[n, Integers] && n > 1`. I am not able to find a way to pass these assumptions from the `Assuming` call to the `TransformationFunctions` or a way to make 2 different `TransformationFunctions` and use vs. the other inside `Simplify` itself. Here an example               ClearAll[n, tf, e, cf];     cf[e_] := Count[e, Gamma, Infinity, Heads -> True] 1000 + LeafCount@e      tf[e_] := If[MatchQ[e, Gamma[1/2 + n]],Sqrt[Pi] (Factorial2[2 *(n - 1/2) - 1])/2^(n - 1/2), e]          Assuming[Element[n, Integers] && n > 1,Simplify[Gamma[1/2 + n] + Gamma[1/3 + n],      TransformationFunctions -> {Automatic, tf},ComplexityFunction -> cf]]      ![Mathematica graphics](http://i.stack.imgur.com/X6AVz.png) But now if I assume `n` is `Real`, I do not want to modify the code above, but I want the `TransformationFunctions` to automatically to detect this and in this case not apply this transformation rule or add some logic inside `Simplify` to use one `TransformationFunctions` vs. the other based on `Assumptions`               ClearAll[n, tf, e, cf];     cf[e_] := Count[e, Gamma, Infinity, Heads -> True] 1000 + LeafCount@e      tf[e_] := If[MatchQ[e, Gamma[1/2 + n]], Sqrt[Pi] (Factorial2[2 *(n - 1/2) - 1])/2^(n - 1/2), e]          Assuming[Element[n, Reals], Simplify[Gamma[1/2 + n] + Gamma[1/3 + n],        TransformationFunctions -> {Automatic, tf},        ComplexityFunction -> cf]]      ![Mathematica graphics](http://i.stack.imgur.com/xM5b0.png) which is wrong since now `n` is not an integer now. I'd like to be able to write               Assuming[Element[n, Reals], Simplify[Gamma[1/2 + n] + Gamma[1/3 + n],     TransformationFunctions ->Cases[Element[n, Reals], Automatic, Element[n, Integers] && n > 1,tf],       ComplexityFunction -> cf]      ]      But the above is not valid syntax. * * *


Clear and Unset doesn't free memory

Example: Try this example only if you have > 4G ram               d = 2000;      f[x_, y_, d_] =           Sum[Subscript[a, i, j]*x^i*y^j,             {i, 0, d - 1}, {j, 0, d - i}];      Then               Clear[f]      or               f[x_, y_, d_] =.      You will see that the memory usage is not reduced after calling `Clear` or using `Unset`. _**Question: How to free the memory when I don't need a function anymore which is already evaluated?_** Edit: I look at the memory usage in taskmgr under Windows OS. As the answers report that the memory is indeed reduce by using MemoryInUse to check it.


How to set restrictions in Manipulate parameters?

I´m trying to insert the typicall 3 variables for probability, with the restriction x+y+z=1 How can I insert this values in a Manbipulate I try               Manipulate[x*y*(1-x-y), {x, 0, 1 - y}, {y, 0, 1 - x} ]      but when I move x, y is moving without I want it.


Finding max value of each column of 4x4 Array

I have the following array in both `MatrixForm` and `List` form               0.474042    0.507508    0.4977      0.539773          0.473447    0.50765     0.483809    0.52489          0.46797     0.483669    0.494823    0.516956          0.467079    0.483509    0.478704    0.501286               A = {{ 0.474042, 0.507508, 0.4977,   0.539773},          { 0.473447, 0.50765,  0.483809, 0.52489 },          { 0.46797,  0.483669, 0.494823, 0.516956},          { 0.467079, 0.483509, 0.478704, 0.501286}         }      I want to get the max value of each column. I've tried the following for the first columns but no help:               Max[A[[All, 1]]]      Any comment will be greatly appreciated.


Faster way to test if an expression equals zero

I want to test if expressions (mix of variables, functions and numbers) are zero valued, as fast as possible, and `PossibleZeroQ` is sometimes very slow. One solution I found was to substitute the variables for random reals and test if the value of the substituted expression is less than, say, $0.0001$. It works good, but maybe there are other solutions out there. I know it can cause some wrong answers, but what is most important is the speed, since I can check the false positive later with `PossibleZeroQ`. Can you think of an algorithm that can perform fast zero value tests in detriment of some loss of accuracy? Edit: I'll post my algorithm here:               TestZeroValuedExpression[expression_,symbolslist_]:=Module[{numericvalue},     Quiet[TimeConstrained[If[Check[         numericvalue=N[Expand[expression/.Table[symbolslist[[i]]->RandomReal[{1,2}],{i,Length[symbolslist]}]]];     ,False]=!=False,         If[Abs[numericvalue]>0.00001,False,PossibleZeroQ[expression]],         PossibleZeroQ[expression]     ],3,False]]     ];


Sorting Eigensystems

SO I have this code:               {evalueb1,evectorsb1} = Eigensystem[Coefficientsp1];      evalueb1 = 1/(evalueb1*2\[Pi]);           For[i=1,i<(2TruncationOrder+1),i++,If[Abs[Im[evalueb1[[i]]]]                                                  <10^-14,evalueb1[[i]]=Re[evalueb1[[i]]],evalueb1[[i]]=evalueb1[[i]]]];           \[Rho]plus1 = Sort[Select[evalueb1,Im[#]>0\[Or](Im[#]==0\[And]Re[#]>0)&],Im[#2]>Im[#1]&];      \[Rho]minus1 = Sort[Select[evalueb1,Im[#]<0\[Or](Im[#]==0\[And]Re[#]<0)&],Im[#2]Im[#1]&];      What I did was sort the eigenvalues based on the sign of the complex part. How can I make it so that I can find the correct eigenvector associated with the sorted eigenvalues?


How to place Plot Information within a Text box on top of a Bar Chart?

How could I place a text box on the top of a bar chart where the top line would have a larger font size than the second line? My Data:               totals4={{1093, "AUSTRALIA"}, {235, "BELGIUM"}, {474, "BERMUDA"}, {187, "BRAZIL"}, {103, "BAHAMAS"}};      This code will plot the `PlotLabel->` as a long string. I would like to move " - excludes USA, as of: June 2012" to the second line with a smaller font and not bold. Ideally this text would be within a box, however I would just be happy to get the second line to display correctly.               BarChart[#, ChartStyle -> "DarkRainbow", PlotLabel ->      Style["Entities with LEI Number - excludes USA, as of: June 2012",      Bold, FontSize -> 12],       ChartLabels -> (Placed[     Rotate[Style[#, Black], Pi/3] & /@ #2, {{.7, 0}, {1, 1}}])] & @@     Transpose[totals4]      ![enter image description here](http://i.stack.imgur.com/ZUnxK.jpg) I have tried this code but it is not displaying correctly:               BarChart[#, ChartStyle -> "DarkRainbow",                  PlotLabel -> Style[TraditionalForm[Grid[{         {TextCell[                  Row[{"Entities with LEI Number (excludes USA)",             HoldForm[Subscript[a, b]], " As of June 2012"}],            TextJustification -> 1], SpanFromLeft},         }, Frame -> All]       ], FontFamily ._ "Times"],       ChartLabels -> (Placed[       Rotate[Style[#, Black], Pi/3] & /@ #2, {{.7, 0}, {1, 1}}])] & @@      Transpose[totals4]      Any help would be appreciated.


Probable Bug in HighlightMesh with 2D Convex Hulls created via ConvexHullMesh

One nice way to view the new and exciting `Mesh` objects introduced in **Version 10** is by utilizing the function `HighlightMesh`, so I've been using it heavily. Problem is, when trying to visualize 2D convex hull regions (3D case works fine) created using `ConvexHullMesh`, `HighlightMesh` essentially ignores the `Options` for styling the face of the 2D polygon region. Here is an example:               SeedRandom[0];     pts = RandomReal[4, {200, 2}];     chull = ConvexHullMesh[pts]      ![Mathematica graphics](http://i.stack.imgur.com/sKju8.png) Now let's `Style` it using `HighlightMesh`               HighlightMesh[chull, {Style[0, Directive[PointSize[0.02], Red]],        Style[1, Thin, Green], Style[2, Directive[Yellow]]}]      ![Mathematica graphics](http://i.stack.imgur.com/4kTSH.png) Notice the `Yellow` `Color` under `Style[2, ..]`, that's for the `Polygon` face. This is obviously ignored for the `Default` color used above. Can anyone reproduce this on **Windows 8.1** and other operating systems and is there an easy workaround for this?


Using PatternTest and/or Condition to detect equal list lengths as well as list element formats

On searching Mathematica.SE for information about overloading functions, I came across several threads about `PatternTest` and `Condition`, and I understand the basic examples like matching by `EvenQ`. However I'm having trouble imagining how I'd use these features to implement checks having to do with "whole" lists. * * * For example, I'd like to define a function `Convert` of the form               Convert[quantities_, prices_] :=      _only_ if `quantities` and `prices` are equal-length lists. In other words, if `Length[quantities] != Length[prices]` then `Convert` should behave as if undefined. * * * For a more complex example, I'd like to define an overloaded version,               Convert[dateQuantityList_, datePriceList_] :=      where `dateQuantityList` and `datePriceList` look like               {{{2012, 1, 1, 9, 30, 7}, 150},      {{2012, 1, 1, 9, 30, 12}, 130},      {{2012, 1, 1, 9, 30, 33}, 470},      ...     }      and               {{{2012, 1, 1, 9, 30, 7}, 24.56},      {{2012, 1, 1, 9, 30, 33}, 24.58},      ...     }      such that the function is only defined if all elements in `dateQuantityList[[All, 1]]` and `datePriceList[[All, 1]]` are valid `DateList`s. (Is there something like a `DateListQ`? But even supposing so, again, I'm not clear on how to apply `PatternTest` or `Condition` to a property of an entire list, not its elements...) (The goal of the latter overload is to do a "left join" based on the date, _i.e._ discard prices that don't have corresponding dates in the quantities list, and calling the original form, `Convert[q_, p_]`. I know how to do that part using `GatherBy`--it's the `PatternTest`/`Condition` part that's completely new to me.) I have many more overloads I'd like to write, but if I can get started with those two examples, I think I can figure the rest out.


Passing lists to functions in a manner that works like pass-by-reference in other languages?

Is it possible to use a list as a variable, i.e., to pass it by reference to a function? In particular, I have a two-dimensional array and a function to get one element specified by its position:               s = {{1, 1, 1, -1}, {1, 1, -1, -1}, {-1, -1, 1, -1}, {-1, 1, -1, 1}};     valueAtPos[positionX_, positionY_, lattice_List] :=         Flatten[Take[lattice, {positionY, positionY}, {positionX, positionX}]]      This works just fine, it does exactly what I want. Now, what I'm actually aiming at is "flipping" the value at a certain position, i.e. $-1 \rightarrow 1$ and vice versa. I tried it with a function and a fixed list and it worked, but since I have more than one list, I want to pass the actual list not a copy as an argument as well. So I tried this:               flip[posX_, posY_, lattice_List] :=        Module[{latticeLocal = lattice, x = posX, y = posY},         latticeLocal =            ReplacePart[latticeLocal, {y,x} -> -valueAtPos[x, y, latticeLocal]] //.             {{1} :> 1, {-1} :> -1};]      If I run, for example, `flip[1, 1, s]`, it should change `s` to               s = {{-1, 1, 1, -1}, {1, 1, -1, -1}, {-1, -1, 1, -1}, {-1, 1, -1, 1}}.      but it doesn't; `s` is left untouched, exactly the same as before. If I run               s = ReplacePart[s,{1,1} -> -valueAtPos[1, 1, latticeLocal]] //. {{1} :> 1, {-1} :> -1};      it does exactly what it's supposed to do. My question is: How can I pass a list, not a copy of the list, to a function so the list I pass will really get modified. (I tried using the list like a normal argument of a function and I got errors. Modules, at least, didn't give me errors) ### Edit Nasser told me to delete the semicolon in `flip` and to assign the output of the function to my original list. That works, of course, but is not quite what I wanted, so I am going to clarify this here. I want to use the `flip` in another function. And I not only want to run the function, I also want to use its output. Look at this:               algorithm[steps_, T_, lattice_List] :=        Module[{latticeLocal = lattice},         For[i = 0, i < steps, i++,            {             (* definig some variables inside the for-loop *)             If[(* some expression *),                latticeLocal = flip[posX, posY, latticeLocal],               0]            }];]      This doesn't work. I need to use the output of `flip` in the for-loop, and I don't have an idea how to do that.


General form of a linear transformation

> Let $v_1 = \begin{bmatrix} 2 \\\ -1 \end{bmatrix}$ and $v_2=\begin{bmatrix} > 1 \\\ -1 \end{bmatrix}$ and let $A= \begin{bmatrix} 3 & 2 \\\ -2 & 1 > \end{bmatrix}$ be a matrix for $T\colon \Bbb R^2\to \Bbb R^2$ relative to > the basis $B = \\{v_1, v_2\\}$. From this I found that: $T(v_1) = \begin{bmatrix} 4 \\\ -1 \end{bmatrix}$ and $T(v_2) = \begin{bmatrix} 5 \\\ -3 \end{bmatrix}$ How would I find a formula for $T\begin{pmatrix} \begin{bmatrix}x_1 \\\ x_2\end{bmatrix} \end{pmatrix}$. The answer in my book is $\begin{bmatrix} -x_1-6x_2 \\\ 2x_1+5x_2 \end{bmatrix}$


Problem with FrameLabel in the ErrorListPlot function

I've been trying to print information on the axes of a graphic. I'm doing that by the option `FrameLabel` in the `ErrorListPlot` function. But it failed. Here the code I'm using               Needs["ErrorBarPlots`"];          d    = Import["teste.txt", "TSV"];     dNew = Table[{{d[[i, 1]], d[[i, 2]]}, ErrorBar[d[[i, 3]]]}, {i, 2, Length[d]}];          ErrorListPlot[dNew, FrameLabel -> {"Position, x (inches)", "Photodetector output (V)"}]      The result ![enter image description here](http://i.stack.imgur.com/vHfJH.jpg) How can I fix it? Thanks for the attention. Hellon


How can I find the derivative of a combinatorial expression?

I want to differentiate the following equation:               n = (nchoosek)*p*(1 - p)^(n - k)      After differentiating my result is:               n = -1/log(1 - p)      But my problem is that I cannot differentiate this. Can anyone please help me to do this?


Difference between sub MathKernel and MathKernel

When I try to run Mathematica processes in parallel on a Linux based server, I see that my server allows 7 MathKernels and 28 sub MathKernels. I was wondering what the difference is and how I can take advantage of the 28 sub MathKernels. I generally run my job like:               for i in $var       do       "path"/math -noprompt -script "scriptname" "parameters" &       done      This results in using different MathKernels. Therefore I am able to do this iteration at most 7 times. I was wondering if I could take use of the sub MathKernel licenses, I can somehow tweak this to run 28 times. Is that possible?


Most convenient way to set legend marker size?

If I add a legend using               Legended[..., SwatchLegend[..., ...]]      then I can explicitly set the legend marker size using the `LegendMarkerSize` option. But I also need to explicitly set the style/colour of the legend elements a second time within the legend expression. It is usually much more convenient to use the `PlotLegens` or the `ChartLegends` option. It spares me the trouble of having to manually match up the legens with the plot or chart. If I use this, can I still control the marker size? Example:               cm = 72/2.54;     BarChart[{{1, 2, 3}, {1, 3, 2}}, ChartLegends -> {"a", "b", "c"}, ImageSize -> 4 cm]      How can I control the legend marker size in the above graphic? Is there anything simpler than an explicit legend specification as below?               colours = {Red, Blue, Black};     Legended[      BarChart[{{1, 2, 3}, {1, 3, 2}}, ImageSize -> 4 cm, ChartStyle -> colours],      SwatchLegend[colours, {"a", "b", "c"}, LegendMarkerSize -> 7]     ]


How to make "Text" Cell which does not auto-format in TraditionalForm in-line math expressions?

This is a continuation of the previous post: How to enter textual subscripts and superscripts?. When dealing with complex in-line math expressions inside a `"Text"` cell _Mathematica_ by default formats them in `TraditionalForm`. Is it possible to force _Mathematica_ to create in-line cells with the same style as the style of enclosing cell?


Function does not compile with Greater in it

I have to speed up a matrix-calculation and would like to use `Compile` for it, though it fails and produces an unknown error message:               compiledFunc =        Compile[{{w, _Real, 2}, {v, _Integer, 1}, {hb, _Real,           1}, {vb, _Real, 1}}, Module[{h, hs, vr, hr},         h = 1./(1. + Exp[-(w.v + hb)]);         hs = Boole@Thread[h > RandomReal[{0, 1}, {Length@hb}]];         vr = 1./(1. + Exp[-((Transpose@w).hs + vb)]);         hr = 1./(1. + Exp[-(w.vr + hb)]);         w + (0.01*(Outer[Times, h, v] - Outer[Times, hr, vr]))         ], Parallelization -> True];          (*       ==> Compile::argcompten: The comparison, Greater, is invalid for tensor arguments. >>     *)      Any idea how I can overcome this and/or speed it up? **Update:** According to the answers, the problem is that `Thread` is not compilable. Substituting it with `MapThread` indeed allows compilation. But then running the code gives another error. (I thought that since it is about the same piece of code, I won't start a new post.)               cFunc = Compile[{{w, _Real, 2}, {v, _Integer, 1}, {hb, _Real,           1}, {vb, _Real, 1}}, Module[{h, hs, vr, hr},         h = 1./(1. + Exp[-(w.v + hb)]);         hs = Boole@           MapThread[Greater, {h, RandomReal[{0, 1}, {Length@hb}]}];         vr = 1./(1. + Exp[-((Transpose@w).hs + vb)]);         hr = 1./(1. + Exp[-(w.vr + hb)]);         w + (0.01*(Outer[Times, h, v] - Outer[Times, hr, vr]))],        Parallelization -> True];          cFunc[w, v, hb, vb]          (*        CompiledFunction::cfse: Compiled expression 1.7+3.2 I should be a machine-size real number. >>             CompiledFunction::cfex: Could not complete external evaluation at instruction 2; proceeding with uncompiled evaluation. >>     *)


How can I close a stream without knowing its name?

If I initialise a stream as follows               OpenWrite["~/example"]      How do I close this stream? `Close` seems to expect a name, but I do not know the name of the stream in this format. [edit] - Thanks for all the responses. It seems the simplest solution was               Close[<full path name to file>]      I had previously tried Close["~/example"] but to no avail.


Finding time-series direction reversal of certain magnitude

I'd like to find the points of a time-series that are a certain distance away (in value, not in time) from the previous maximum, which I consider a reversal. For example, for `{1, 2, 3, 5, 10, 8, 6, 3}` with a threshold of `4`, the reversal point would be `6`, since it's `4` units away from the previous maximum of `10`. I want to find all such reversal points, but at each one I need to reset the running maximum (or split the list and start again on the new list). Here is some code to find the first reversal. It computes the distance from each element to a rolling maximum, then looks for the first difference bigger than the threshold.               ts = {1, 2, 3, 5, 10, 8, 6, 3};     rollmax = FoldList[Max, First[ts], Rest[ts]];     delta = rollmax - ts;     sel = Map[# >= 4 &, delta];     index = Position[sel, True, 1, 1]      I can do this in a procedural way, but it's probably not the preferred way. I'm new to functional programming and I don't quite know what sort of patterns are available that would help me here. And if there was a better way of writing the above code, please let me know.


Workarounds for a possible bug in the linearity of FourierTransform

This is somewhat similar to this question, except the problem I am encountering is to do with Fourier transforms of scalar multiples of functions and their derivatives. I wish to input `FourierTransform[a*f[t],t,x]` and have Mathematica simplify it to `a*FourierTransform[f[t],t,x]`, and, equivalently, to input `FourierTransform[f'[t],t,x]` and have Mathematica simplify it to `ix*FourierTransform[f[t],t,x]`. I'm taking the Fourier transform of a system of differential equations for functions `f[t]`,`g[t]`, etc., in order to instead only have to solve a system of algebraic equations for their Fourier transforms, but Mathematica seems to be having some problems doing this. Note that `LaplaceTransform` works exactly as expected, but for some reason `FourierTransform` doesn't perform the expected simplification. If someone could suggest a solution that also incorporates the distributive property that `FourierTransform` was shown to have a problem with in the question I linked, that would be ideal. # Example This is essentially what I'd like `FourierTransform` to do:               LaplaceTransform[{a*f[t]+b*g'[t]==0,c*f'[t]+d*g[t]==0},t,x]      which returns:               {a*LaplaceTransform[f[t],t,x]+b*(-g[0]+x*LaplaceTransform[g[t],t,x])==0,     c*(-f[0]+x*LaplaceTransform[f[t],t,x])+d*LaplaceTransform[g[t],t,x]==0}      Instead, however, `FourierTransform` of the same expression returns:               {FourierTransform[a*f[t]+b*g'[t]==0,t,x],FourierTransform[c*f'[t]+d*g[t]==0,t,x]}      # Edit There is a solution to this problem here, although it doesn't actually explain `FourierTransform`'s strange functionality.


Ugly font rendering (ubuntu 12, overrides system settings)

Mathematica 9 on Ubuntu 12 renders fonts very poorly. Text is readable, but it makes it very hard to concentrate on programming. Since smoothing on Ubuntu on low DPI screens isn't very good either, I turned it off and have been using fonts that are friendly without smoothing (e.g. Courier New). Mathematica completely ignores this fact and smoothes them anyway (in some proprietary way that seems to be different from the way how ubuntu smoothes them (when smoothing is system-wide enabled)). Is there any option how to modify/disable this behavior ?


Inverse on a restricted domain

I have a function, whose domain is [0,1]. The function is               f = Piecewise[{{Exp[-β * (-Log[#])^α], 0 < # <= 1}}, #]&      with `β > 0` and `α > 0` (side note: is this the best way of defining the function such that it's `Exp[-β * (-Log[#])^α]` on (0,1] and 0 at 0?) I would now like to use the inverse of this function, which I'm pretty sure exists (and is `E^(-(-1)^((1/α)) β^(-1/α) Log[w]^(1/α))`). However,               InverseFunction[f]      simply returns the call and not the actual inverse. At this point I'm not sure whether it's my lousy _Mathematica_ skills that keep me from getting the correct inverse or whether there's something in the math that I've neglected to consider. What am I doing wrong? How do I tell _Mathematica_ to just find the inverse on [0,1] and how do I tell it that both parameters are positive?


Make a table of changes in US coinage

I thought of an innovative use of Mathematica/Alpha that I think Stephen Wolfram would really love, but I can't figure out how to get it to work. The idea is to make a table that would chart the changes in US coinage over time pictorially. So, the rows would be time periods, and the columns would be denominations (penny, nickel, dime, quarter, half dollar, dollar, possibly eagle and double eagle). So, for example, I think the coinage did not change from 1921 (when the Peace Dollar was first issued) to 1932 (when the Washington Quarter was adopted). So, that would be one row in the table, 1921-1932 and each cell in that row would show the coin from that period. I tried using Wolfram Alpha to get the coin images but it was hard. For example, "Washington Quarter" just returns information about the quarter fraction, not the coin. How can I go about making an expression/module that will build this table?


Defining a function (but not explicitly)

I have a question that must have a simple answer, but googling and searching this website did not produce an answer, so I'm asking it here. I'm working with three variables $x, y, \theta$, and I want to tell mathematica that I have a function $f$, which is a function of $x$ and $y$ alone. I **do not** have an expression for $f$; all I want is for mathematica to produce outputs like $f_x, f_y, f_{xx}$, etc, when asked to differentiate $f$, for instance. But I do want to get $0$ when I ask mathematica for $f_{\theta}$, since $f$ doesn't depend on $\theta$. How do I define this $f$? Thank you very much!


Is mathematica storing information it shouldn't store?

I'm seeking to find solutions to a numerical integration with a large set of parameter combinations (basically, I'm doing a brute parameter sampling). Yet, I believe the memory of the computer is storing unnecessary information, but I can't understand why: the memory stores near 16Gb of memory coming from Mathematica Kernel, while the output is only ~25mb. This sometimes makes the computer run out of memory and Kernel quitting. I am also afraid this may slow my computations. I will abbreviate a lot the code because I just want to know if I'm doing something fundamentally wrong with my rationale, specially on **point 3 below**. Basically, I am numerically integrating some equations for many parameter values. The output of the integration is then used to compute values of the dependent variables at specific time points. These values are my output ~25 mb. ## **Note that I simplified my code a lot** , and also left some of it blank because it is unnecessary to explain what I am doing. What I'm doing is the following: **1- Considering a very large table**               Table4 =       Sort[        Flatten[         Table[          {10^b, 10^g, 10^v, 10^k}, {b, -5, 5, 0.5}, {g, -7, 3,            0.5}, {v, -11, -1, 0.5}, {k, -8, 2, 0.5}          ],         3]        ];      **2- I have a function`deqns4` that is simply a system of ODEs to be numerically integrated** and is called several times in **point 3** (This is a random system of equations, my real one has 13 dependent variables).               deqns4[b_, g_, v_, k_] :=       {A'[t] == ki H[t] + k X[t] - b A[t],        X'[t] == g A[t] - v X[t] - kc X[t],        A[0] == 2,        X[0] == 1        };      **3- Then, the following function calls`deqns4` several times, to **numerically integrate the equations and output the values of the dependent variables** at some time points, for the given parameter values in `Table4`:               lsim4[{b_, g_, v_, k_}, ba_] :=       Block[{ep, initconds, sssol0, tsim4, tsim3, tsimc50, tsimc100, c1,     c2, c3, c4, c5, c6, c7},          (*This finds initial conditions*)        sssol0 = Cases[          NSolve[           Rationalize[            Evaluate[{                ki H + k X - b A == 0,                g A - v X - kc X == 0} /. ki -> 2 /. kc -> 0.1             ],            0            ],           {A, X}           ],          {Rule[_, _?NonNegative] ..}          ] /. {A -> A0, X -> X0};          (*This and the following commands use the initial conditions above to numerically integrate the system of equations "deqns4"*)     tsim4 = Flatten[         NDSolve[          Rationalize[           Evaluate[            Join[               {H[t] == 0.009 Exp[-0.1 t] + ba },               deqns4[b, g, v, k]               ] /. kc -> 0.1 /. sssol0],           0           ],          {A, X, H},          {t, 0, 9720}, MaxSteps -> 1*^12          ],         1         ];          (*tsim3, tsimc50, and tsimc100 are also numerical integration of deqns4,    similarly to tsim4*)     tsim3 = Flatten[NDSolve[(*...left blank to simplify...*)], 1];     tsimc50 = Flatten[NDSolve[(*...left blank to simplify...*)], 1];     tsimc100 = Flatten[NDSolve[(*...left blank to simplify...*)], 1];          (*then I want the output to be a set of values computed from the \ numerical integration above*)   c1 = (A[324] + X[324]) 100 /. tsim4;          c2 = (A[9720]) 100/(A[0]) /. tsim4;          c3 = (X[3240]) 100 /. tsim4;          c4 = (X[9720]) 100 /. tsim4;          c5 = (A[3240] + X[3240]) 100 /. tsim3;          c6 = (X[3240]) 100 /. tsimc100;          c7 = (X[3240]) 100 /. tsimc50;          {c1, c2, c3, c4, c5, c6, c7}          ];          lsimsols = ParallelMap[lsim4[#, 1.2] &, Table4];          (*output is a list with the form lsimsols={{0.1,0.99,100,0.52,76,100,100},{0.01,0.99,90,53,75,100},etc}*)      ## My questions are the following:   1. Is `NDSolve`storing information each time it runs, though it is within a `Block` function?   2. The function `lsim4` is only outputing `c1` to `c7` for each element of `Table4`. This is what is being stored by `lsimsols`, and is the only information I am interested in. Yet, a lot more data is being stored by the kernel. Is there any way for me to avoid storage of so much information?   3. Even without specifying `MaxStepSize`, takes me ~4 hours to run all the values of parameters. Is there any more efficient way of doing this parameter sampling other than `ParallelMap`? Thanks in advance! **Edit:**   * as suggested in the comments, I set `$HistoryLength=0` **which did not change all the memory allocated to Mathematica** \- I still get about 16 Gbs of stored information.   * Also, `ParametricNDSolve` seems to produce faster results than `NDSolve`. **Edit #2:**   * Someone suggested to use `Map` instead of `ParallelMap`, as this would possibly allow less memory usage. This didn't make any improvements.   * The only way I was able to attain a partial solution to the problem above is by splitting `Table4` in multiple parts and run `deqns4` for each part separately and then joining everything.


Exporting PDF file - incorrect graphic

I export graphics to PDF using:               Export["/path/figure.pdf", plotname]      It gives me more than enough quality for PDFLatex. But somehow, some exported plots have 'extra' lines (it doesn't happen when I export to PNG/JPG for example): ![image showing plot with extra lines](http://i.stack.imgur.com/J7JVN.pngFunctions) It doesn't happen to all exported plots, and in Mathematica itself, the plot looks correct: no extra lines visible. The `ListPlot` is more than just a `ListPlot` (it uses external data to make five different `ListPlot`s and is then showed in one plot using `Show`), but the other plots made in the same way are perfectly fine, so I guess it has nothing to do with how the plot has been generated. Sorry I am sich a n00b, I don't know how to add all this code. So again, I have shared it online: [link to notebook code].2 The funny thing is, I have 'built' three of these plots, only the one in the shared code, gives this problem. This plot is the 'middle' plot, i.e., there has been a plot made before, then I clear the counters, and start again. FYI: You can't run the code, because it needs external data. The external data are many CSV files containing 9 rows of each a text string and a numeric value. I am using Mathematica 9.0.1.0 on Ubuntu 13.04. Thinking it might be some 'leftover' information, I've tried to clear all parameters/variables, quit the kernel (local), quit Mathematica as a whole. But the problem isn't solved. I hope someone here knows what might be going on. I prefer not to change all my figures to a different format. If there is a best format for PDFLatex, then of course I will reconsider, at least for the future. But I expect PDF to fit perfectly with PDFLatex...


How to insert a zoom inside the main plot

As the title indicates, I want to add inside the main plot (preferably at the lower left part) a zoom. Here is the corresponding Mathematica code:               Clear["Global`*"];       Off[General::spell];          Vd = -(Md/Sqrt[b^2 + R^2 + (a + Sqrt[h^2 + z^2])^2]);     Vn = -(Mn/Sqrt[R^2 + z^2 + cn^2]);     Vper = k*R^3 + λ*(R^2 + β*z^2)^2;     Vtot = Vd + Vn + Vper;     Veff = Vtot + Lz^2/(2*R^2);          Md = 12000; b = 8; a = 3; h = 0.1;     Mn = 400; cn = 0.25;     k = -0.35; λ = 0.01; β = 0.01;     Lz = 20;     E0 = -1100;          C0 = ContourPlot[Veff, {R, 0.001, 35}, {z, -80, 80}, Contours -> {E0},     PlotPoints -> 200, ContourShading -> False,      ContourStyle -> {Black, Thickness[0.003]},      PerformanceGoal -> "Quality", ImageSize -> 550];          SetDirectory[" ... "];     data = ReadList["orb_RR.out", Number, RecordLists -> True];     S0 = ListPlot[Flatten[List /@ data[[All, {2, 3}]], 1], Joined -> True,      PlotStyle -> Darker[Gray]];          P0 = Show[{C0, S0}, Frame -> True, FrameLabel -> {"R", "z"},      RotateLabel -> False, Axes -> False,      FrameStyle -> Directive[FontSize -> 17, FontFamily -> "Helvetica"],       PlotRange -> {{0, 35}, {-80, 80}}, ImageSize -> 550]     P1 = Show[{C0, S0}, Frame -> True, FrameLabel -> {"R", "z"},      RotateLabel -> False, Axes -> False,      FrameStyle -> Directive[FontSize -> 17, FontFamily -> "Helvetica"],      PlotRange -> {{0.3, 4.5}, {-5, 5}}, ImageSize -> 550]      The main plot which is produced by `P0` is the following ![enter image description here](http://i.stack.imgur.com/avTWI.jpg) Obviously, it is impossible to understand and interpret the orbit which is inside the closed curve. One may argue, that this issue could be easily solved by just changing the ranges of plot. However, this is not very wise approach, since I need to present the entire area defined by the closed curve and then point out that the orbit is indeed confined only at a very small sub-area. So, I have to incorporate the zoom plot created by `P1` ![enter image description here](http://i.stack.imgur.com/akB8Z.jpg) using the specified ranges preferably at the lower left side of the main plot (where there is plenty of available space). It would be very nice if there were also arrows pointing the original position of the zoom. The file containing the orbit data can be downloaded from here: enter link description here Any ideas on how this could be done? Many thanks in advance!


ListLinePlot x-axis units label

If I want to label the $x$-axis of a `ListLinePlot` , how do I do that? There are two types of label:   * a **units label** which would go to the **right of the axis** ,  and then potentially you could have an   * **axis label below it**.  What would be the way to enter both types of text?


truncating terms in symbolic expression basing on their values

I need to simplify big symbolic solution of equations system by truncating terms that are orders of magnitude less then others in subexpressions like a + b. The solution is big fraction with sum of terms in numerator and denominator like _a b + c ( d - f + g + ..._ where every symbol has value (real number). Is it possible to apply rule like this to solution: _replace a + b by a, if Abs[a] >> Abs[b] (say, 1000 times more), by b, if Abs[a] << Abs[b], or leave it as a + b in other cases_. Repeated application of such a rule should result in symbolic expression that is much simpler then exact solution, but is good enough approximation for concrete values of symbols. I am new to Mathematica, searched for similar questions but didn't find any. Minimal working example: solving eq gives solution that should be simplified by truncating terms basing on parameters alpha and beta below:               v1 = α1 a - β1 b;     v2 = α2 a;     v3 = α3 c;     eq = {-v1 - v2 == 0, v1 + v3 == 0, a + b + c == p};     Solve[eq, {a, b, c}]          α1 = 1000; β1 = 1000; α2 = 1; α3 = 1;


Feed a Manipulate[] Output into a Graphics[]

Please consider :               allTeamsOf5 = Subsets[Range[12], {5}];          rosterRandomAttributes = Table[Table[Round[RandomReal[], .1], {10}], {12}];          rosterRAMean = Mean@rosterRandomAttributes;          rosterRASD = StandardDeviation@rosterRandomAttributes;          allTeamStats = rosterRandomAttributes[[allTeamsOf5[[#]]]] & /@                     Range[Length@allTeamsOf5];          allTeamAverageStats = Mean /@ (allTeamStats[[#]]\[Transpose]) & /@ Range[792];          allTeamsDistToMean =     Total[(allTeamAverageStats[[#]] - rosterRAMean)/rosterRASD] & /@ Range[792];          distToMean = (rosterRandomAttributes[[#]] - rosterRAMean) & /@ Range[12];      The below essentially compute the best team we can get out of this roster emphasizing on different attribute through weight. It output a list of 10 value representing the distance to the mean for each.               Manipulate[(Flatten@         allTeamAverageStats[[          Flatten@Position[            Total[{v1, v2, v3, v4, v5, v6, v7, v8, v9, v10}/            Total@{v1, v2, v3, v4, v5, v6, v7, v8, v9, v10} (            allTeamAverageStats[[#]] - rosterRAMean)/rosterRASD] & /@          Range[792],         Max[Total[{v1, v2, v3, v4, v5, v6, v7, v8, v9, v10}/             Total@{v1, v2, v3, v4, v5, v6, v7, v8, v9, v10} (             allTeamAverageStats[[#]] - rosterRAMean)/rosterRASD] & /@           Range[792]]]]]) - rosterRAMean,      {v1, Range[.1, 1, .1]},      {v2, Range[.1, 1, .1]},      {v3, Range[.1, 1, .1]},      {v4, Range[.1, 1, .1]},      {v5, Range[.1, 1, .1]},      {v6, Range[.1, 1, .1]},      {v7, Range[.1, 1, .1]},      {v8, Range[.1, 1, .1]},      {v9, Range[.1, 1, .1]},      {v10, Range[.1, 1, .1]}, ControlType -> Manipulator]      ![enter image description here](http://i.stack.imgur.com/bUDxy.png) Now I would like the result of that manipulate to feed the below plot : (using solution posted on How can I create a ColorFunction using Blend? )               Show[      Function[attributes,        Graphics[{        Blend[{        {-Max[Abs[distToMean[[1]]]], Red},        {0, LightRed}, {0, LightGreen},        {+Max[Abs[distToMean[[1]]]], Green}},        distToMean[[1]][[attributes]]],       Rectangle[{If[distToMean[[1]][[attributes]] < 0,          distToMean[[1]][[attributes]]*10, 0],         attributes - 1}, {If[distToMean[[1]][[attributes]] < 0, 0,          distToMean[[1]][[attributes]]*10], attributes}],       PlotRange -> {{-6, 6}, {0, 10}}}, AspectRatio -> 16/9,      Epilog -> {Black, Thickness[.05], Line[{{0, 0}, {0, 11}}]}]] /@      Range[10], Frame -> False, FrameTicks -> False]      ![enter image description here](http://i.stack.imgur.com/8vJh8.png) **I would like the output of the manipulate to feed the Graphics instead of distToMean[1]** Trying to nest a With[] to avoid repeating the long code, failed for reason I came to understand. I still don`t know how I could solve my problem


How can I fix my keyboard-free panning?

I'm trying to make a graphics display on a touchscreen device in Mathematica. This means that there will not be a keyboard available for functions such as Panning and Zooming. Because of this, I have created a scaling system to allow zooming, and a series of Events that are bound to aspects of panning. My code worked fine on a simple object, using for example a green cylinder and just moving the center of view:               EventHandler[     Dynamic[Graphics3D[{color, Cylinder[]},      ViewCenter -> {{1/2, 1/2,        1/2}, {x = CurrentPosition[[1]] + value[[1]],        y = CurrentPosition[[2]] - value[[2]]}},      RotationAction -> "Clip"],      Initialization :> (color = Green; value = {0, 0};      CurrentPosition = {1/2, 1/2})],     {{"MouseDown", 2} :> (a = CurrentValue[MousePosition];      pt = CurrentValue[ImageSize]), {"MouseDragged",      2} :> {b = CurrentValue[MousePosition], drag = b - a,      val1 = drag[[1]]/(pt[[1]]), val2 = drag[[2]]/(pt[[2]]),      value = {val1, val2}}, {"MouseUp", 2} :> {value = {0, 0},      CurrentPosition[[1]] = x, CurrentPosition[[2]] = y}}]      (As a side note, I realize that most of you will probably find my code very sloppy, but I'm just a student and coding isn't really my forte) Above, I establish the Graphic wrapped in Dynamic, and make it so that your mouse position is initialized upon a right-click, the difference between your mouse and the initial click is recorded, and this distance is scaled and changes the two-dimensional center of view. However, when I go to a much more complex manipulate function to allow for several objects that can be toggled on and off, zoom functionality and this panning system, everything works fine until the image is rotated. Following the rotation, my pan system does not work, and I was hoping that someone could tell me how to go about fixing my code. Sorry for this huge chunk of code, but here is the graphic that is not working.                   EventHandler[Dynamic[Manipulate[Show[     {If[x1, obj1, blankobj], If[x2, obj2, blankobj],       If[x3, obj3, blankobj], If[x4, obj4, blankobj],       If[x5, obj5, blankobj]},     RotationAction -> "Clip",      PlotRange -> {{scaling[[1]], -scaling[[1]]}, {scaling[[         2]], -scaling[[2]]}, {-zscaling, zscaling}}, Axes -> False,      ViewCenter -> {{1/2, 1/2,         1/2}, {x = CurrentPosition[[1]] + value[[1]],         y = CurrentPosition[[2]] - value[[2]]}}],      Style["Example Graphic", 22, Bold],     Delimiter, Style["Component Toggle", 16, Bold],     Button["Red Sphere", x1 = Not[x1]],     Button["Blue Cylinder", x2 = Not[x2]],     Button["Black Line", x3 = Not[x3]],     Button["Yellow Polygon", x4 = Not[x4]],     Button["Green Cuboid", x5 = Not[x5]],     Delimiter, Style["Zoom Options", 16, Bold],     {{scaling, {-3, -3}, "Horizontal Zoom"}, {-5, -5}, {-1, -1},      ControlType -> Slider2D},     {{zscaling, -7, "Vertical Zoom"}, -10, -4},     ControlPlacement -> Left,     Initialization :> (value = {0, 0}; CurrentPosition = {1/2, 1/2};      x1 = True; x2 = True; x3 = True; x4 = True; x5 = True;      obj1 = {Graphics3D[{Red, Sphere[{0, 0, 2}]}]};      obj2 = Graphics3D[{Blue, Cylinder[]}];      obj3 =        Graphics3D[{Black, Thick, Dashed,          Line[{{-2, 0, 2}, {2, 0, 2}, {0, 0, 4}, {-2, 0, 2}}]}];      obj4 =        Graphics3D[{Yellow,          Polygon[{{-3, -3, -2}, {-3, 3, -2}, {3,             3, -2}, {3, -3, -2}}]}];      obj5 =        Graphics3D[{Green, Opacity[.3],          Cuboid[{-2, -2, -2}, {2, 2, -1}]}];      blankobj = Plot3D[r, {x, 0, 5}, {y, 0, 5}];      )]], {{"MouseDown", 2} :> (a = CurrentValue[MousePosition];      pt = CurrentValue[ImageSize]), {"MouseDragged",      2} :> {b = CurrentValue[MousePosition], drag = b - a,      val1 = drag[[1]]/(pt[[1]]), val2 = drag[[2]]/(pt[[2]]),      value = {val1, val2}}, {"MouseUp", 2} :> {value = {0, 0},      CurrentPosition[[1]] = x, CurrentPosition[[2]] = y}}]


Reduce and Solve unable to solve equation

I have the following equation. Why aren't `Solve` and `Reduce` able to find the solution?               Reduce[2 n - Tanh[z] Tanh[2 n z] == 0, z]


The i-th element of a permutation

I am trying to run something of the form               p = Permutations[Range[1,16]];     result={};     Table[If["p[[i]] satisfies some conditions",result=Append[result,p[[i]]]],{i,1,Length[[p]]}];      and I get an "out of memory error" when defining p. I am trying to find a way around this, especially since I don't really need to store Permutations[Range[1,16]] at any given point. All I want is access the i-th element of it and run some tests (for all i). I understand this might take ages but I can afford to let the program run for months, whereas the memory of the computer I am using is restricted. Any ideas? * * * A "proper" minimal example:               p = Permutations[Range[1,16]];     result={};     Table[If[p[[i]]==Range[1,16],result=Append[result,p[[i]]]],{i,1,Length[p]}];     result      and the expected output would be {1,2,3,4,..,16}.


Need to create a function to generate all permutations of Range[$n$]

Basically I need a function that takes a list and gives all the possible permutations of it. The reason I can't use `Permutations` is that I have to apply another program that will score each permutation separately, based on certain criteria, and `Permutations[Range[14]]` gives entirely too much data. The function has to work for a list `Range[int]` up to `int = 14`, each permutation has to include all the members of the original list with no repeats, and the function has to produce all possible permutations. I will appreciate any help: I'm very stuck.


Extending a grid to avoid line breaks in text

I was wondering what the best way is to extend the cells in a `GraphicsGrid` so that my text fits without line breaks. My problem is illustrated by the graphic produced by the code below:               GraphicsGrid[{       {Graphics[{Blue, Rectangle[{1, -1}]}],         Style["Antidisestablishmentarianism", FontSize -> 30],         SpanFromLeft},       {Graphics[{Red, Rectangle[{1, -1}]}],         Style["Pneumonoultramicroscopicsilicovolcanoconiosis", FontSize -> 30],        SpanFromLeft}}]`      ![enter image description here](http://i.stack.imgur.com/nvYrv.png) I've been looking for ways to extend the cells on the right of the `GraphicsGrid` so that the text fits in on one line. In the code above, I've used `SpanFromLeft` to extend the cells a little. I would have to use many `SpanFromLeft` commands in order to fit the word next to the red square. So I was hoping that someone knew of a better way of doing this.


How can I differentiate Numerically?

Mathematica has two ways to integrate: `Integrate` and `NIntegrate`.   But what about `D`? `D` and `Derivative` are for symbolic differentiation. How can I differentiate _numerically_?


Local max/min of Mathematica data sets

Is there a way in Mathematica to find the local maxima of a set of points? Suppose you have               points={{xa,ya},{xb,yb},{xc,yc}...}          peakQ[{{x1_,y1_},{x2_,y2_},{x3_,y3_}}] := Abs[y1] > Abs[y2] && Abs[y2] < Abs[y3];     peaks=Map[#[[2]]&, Select[Partition[points,3,1],peakQ[#]&]]      Is it correct because in this way I find points but from plots I can see that I have lost some points.


How to store multiple plots to be viewed later

I need to be able to import my data and create multiple listlineplots, but my inputs for each plot are very large. I am able to assign variables to each plot and then use GraphicsGrid to view them all, but i have to copy and paste the input for each plot. I am wondering if there is a way to create the plot, store it, then create the next plot and store it along with the first, and so on. This way when i am done creating all plots I can just view them all and compare them together in a grid. I have attempted to use AppendTo, but i am unable to even store two plots, as the first plot is erased in some manner. Here is an example of how I start:                       SetDirectory["Z:\\130709"];             filename = "af.txt";         datafile = Import[filename, "CSV"];             plot = ListLinePlot[datafile]     filename2 ="ai.txt";     datafile2 = Import[filename2,"CSV"];     plot2 = ListLinePlot[datafile2]     AppendTo[plot,plot2]      So I am trying to store the plot, and then my hope is to just change the input filename and continue on to save space. Any help would be appreciated.


NDSolve with vectors

I'm stumped. I'm trying to write this using vectors, but the 2nd derivative isn't being expanded like I expected it to be. This is a system of equations for a projectile with quadratic drag and gravity (the linear drag is ignored for now). Negative Z is down, X and Y are the horizontal plane. If I write it as 9 equations, one for each coordinate, it works fine, but I'd rather use vectors since it is shorter and (to at least me) more obvious what is going on. Plus since I am new to Mathematica it would be good to learn more/better ways to use it.               gravity = 10;     withDrag[p0_, v0_, drag_] :=       NDSolve[{        p[0] == p0,        p'[0] == v0,        p''[t] == drag * Norm[p'[t]] * p'[t] + {0,0,-gravity}},       {p}, {t, 0, 5}]          withDrag[{0,0,0}, {0,10^4,10}, 0.001]      I get:               NDSolve::ndfdmc: Computed derivatives do not have dimensionality consistent with the initial conditions. >>          NDSolve[{       p[0] == {0, 0, 0},        p'[0] == {0, 10000, 10},        p''[t] == {         0.001 Norm[p'[t]] p'[t],          0.001 Norm[p'[t]] p'[t],          -10 + 0.001 Norm[p'[t]] p'[t]}},       {p}, {t,0,5}]      I formatted the output to make the error more obvious. Each of elements of the p'' vector has all three elements of p'[t]. Each one should really be p'[t][[dim]] (or something like that). Any clues as to what I'm doing wrong?


Generate conditions seems to not work

I am trying to compute the following integral               Integrate[E^(I*k*Omega*t), {t,0,T}, GenerateConditions->True]      for which Mathematica returns               ((-I)*(-1+E^(I*k*Omega*T)))/(k*Omega)      apparently not recognizing that `k` can be 0. Why `GenerateConditions` doesn't work as expected?


Solving a PDE containing DiracDelta

I want to get the answer from a PDE: $$\begin{align*} \frac{\partial \rho(r,t)}{\partial t}&=Dr^{-2}\frac{\partial}{\partial r}r^2h(r)e^{-U(r)}\frac{\partial}{\partial r}e^{U(r)}\rho(r,t)-\left(\frac{\lambda}{g(\sigma)}\frac{\delta(r-\sigma)}{4\pi\sigma^2}+\frac{3\lambda}{4\pi r^6}\right)\rho(r,t)\\\ U(r)&=-\frac4r\text{; }\sigma=D=\lambda=h(r)=1\\\ \rho(r,t=0)&=g(r)=e^{-U(r)}\text{; }\lim_{r\to\infty}\rho(r,t)=1\text{; }\left.4\pi\sigma^2 Dh(\sigma)\frac{\partial}{\partial t}e^{U(r)}\rho(r,t)\right|_{r=\sigma}=\lambda e^{U(\sigma)}\rho(\sigma,t) \end{align*}$$ The PDE has one `DiracDelta[]` function. When I tried to solve the equation with `NDSolve[]`, it gave me               NDSolve::ndnum: Encountered non-numerical value for a derivative at t==0.         So I wanted to know the reason of message.   Using `r-sigma` instead of the delta function, `DiracDelta[r-sigma]`, I could get an answer from `NDSolve` without the above error message. However, it was not the answer of interest. How can I solve the problem with `DiracDelta[]` function? Thanks in advance :) *Codes start from here :               σ = 1     rc = -4     λ = 1     sink[r_, λ_] = (3 λ)/(4 π r^6)     U[r_] = rc/r     g[r_] = Exp[-U[r]]     Dif = 1     h[r_] = 1     r0 = 1;     tmax = 0.01;     rmax = 1000 Sqrt[6 Dif tmax] + r0;          sol = NDSolve[{D[ρ[r, t], {t, 1}] ==      Dif r^-2 D[        r^2 h[r] Exp[-U[r]] D[Exp[U[r]] ρ[r, t], {r, 1}], {r,          1}] - (λ/g[σ] DiracDelta[r - σ]/(          4 π σ^2) + sink[r, λ]) ρ[r,         t], ρ[r, 0] == Exp[-(U[r] - rc/rmax)], ρ[rmax, t] ==      1, 4 π Dif h[σ] (        D[Exp[U[r]] ρ[r, t], {r, 1}] /.         r -> σ) == λ Exp[U[σ]] ρ[σ,        t]}, ρ, {r, σ, rmax}, {t, 0, tmax},        PrecisionGoal -> 4, StartingStepSize -> 0.0001,        Method -> {"MethodOfLines",      "SpatialDiscretization" -> {"TensorProductGrid",        "MinPoints" -> 100, "MaxPoints" -> 200}}]          ρn = First[ρ /. sol]     Plot3D[ρn[r, t], {r, σ, rmax/100}, {t, 0, tmax}, PlotRange -> All]


How to preserve clipping when exporting a framed histogram with font embedding?

I work with histograms and would like to export it to EPS format. I've noticed that my exported image loses the PlotRangeClipping option that I set up when I export the plot. This is true for at least EPS, PNG and PDF. Based on this question and its accepted answer, I defined the function               OutlinedExport[name_,gr_,opts:OptionsPattern[]]:=     Export[         name,         First@ImportString[             ExportString[                 gr,                 "PDF"             ],             "PDF",             "TextOutlines"->True         ],         FilterRules[             {opts},             Options[Export]         ]     ]      Now here is an example of histogram               data = Table[InverseCDF[NormalDistribution[0, 1], Random[]], {i, 1000}];     PlotB = Histogram[data, 20,         PlotRange -> {{-2, 2}, Automatic},         Frame->True]     OutlinedExport["output2.pdf", PlotB, ImageSize -> 600]      which appears to have lost the clipping during the export. ### The questions are :   * Is there a way to preserve clipping as defined through options like PlotRangeClipping and PlotRangePadding ?    * If the problem is related with the OutlinedExport, is there a way to answer my question while also keeping the outline of fonts (which I need but have here removed for the sake of example) ?


Perfect numbers

The question given to me: **a**. Find the _perfect numbers_ between $1$ and $10^6$ **b** : Find the _abundant numbers_ between $1$ and $1000$ * * * For **a** , I wrote               Select[Range[1, 10^6], All]      I think I'm suppose to use divisor in there somewhere, but I'm not sure where to put that since I think me selecting all the numbers between $1$ and $10^6$ won't give me the list of all the perfect numbers... For **b** , I think it's similar to part **a** , which I'm in a dead end with. * * * I'm trying to find a simple input since I'm still a beginner and want to stay with the basics.


DSolve not finding solution I expected

Try to solve the following ODE via `DSolve` $$ \left\\{\begin{aligned} y'(x)+2 y(x) e^x-y(x)^2 &= e^{2 x}+e^x \\\ y'(0) &=1 \end{aligned}\right. $$ The expected solution is $y(x)=e^x$, but _Mathematica_ produces the message: > For some branches of the general solution,``the given boundary conditions > lead to an empty solution **Note:** $y(x)=e^x$ is obviously a special solution to the original ODE and satisfies the initial/boundary value condition which can be easily verified by substituting it into the ODE. Additionally, it is easy to deduct that: $y'(0)=1\Leftrightarrow y(0)=1$ for this ODE; How to handle it?


Right aligning a button in a dialog

What is the best way to right align a button in a dialog window, regardless of the window's `WindowSize`? Here is a resizable window to test on:               CreateDialog[      Column[{"Here's some text text text text text text text",               ChoiceButtons[]}],       WindowFrameElements -> {"ResizeArea"},       WindowFrame -> "Normal"]      I would like the button to always be right aligned. Some unsatisfactory solutions I thought of:   * Put the button in an `Item` and right align. Then the right margin is determined by the `Column` size which can't easily be set in pixels.   * Put the button in a `Panel`, right align it, and set a fixed size on the panel. Again, the size is determined by the panel size, not the window size. **Use case:** Suppose we need to create an alternative to `MessageDialog`. This new function, `myMessageDialog`, should take the `WindowSize` option, and the created notebook should respond to `SetOptions[nb, WindowSize -> ...]` The dialog buttons should always be aligned to the right edge of the window regardless of the window size.


Saving my code before cell evaluations: Insurance against front end hanging

I guess my programming working style is not unique. I develop programs one cell at a time, and when I have some confidence about what I did, I put all my mess together refining the code, building up functions from nailed constructs, scoping variables, etc. That usually means being on a dirt road most of the time: evaluating a lot of cells, inspecting FullForms, checking different conditions, clicking the `|Show More|` button, etc. Before I perform any action on my ongoing `.nb` I _should_ save my work in advance.   But alas! My mind is weak, my memory fades and my feeble fingers are too quick for my tired eyes.   So, when I press `Shift-Enter` or `|Show More|` and my Front End hangs, I remember Michael Douglas' D-FENS character in "Falling Down" with utmost sympathy. I would like an automatic way to save _my input cells_ (not the output ones, as they could be really large) in a backup .nb file before and every time any computation is requested. How? PS:   I must confess, my FrontEnd-fu is still in its teens.   I _think_ `$pre` could be set to the desired command, but I don't know how to select only the input cells and save them programmatically.


Possible to import Excel formatted text?

Is it possible to import Excel text markup such as underlines? For example: ![enter image description here](http://i.stack.imgur.com/zGGZ6.jpg) Yet               Import["/Users/alancalvitti/Dropbox/Understars/text.is.lyte/litany.of.\     duals/litany.of.duals.xlsx"][[1, 1]]      returns a list with the plain string:               {"nyt 7.23.12", "question for a ceo: what is yahoo?", "17 years after \     the company was founded, you still have to wonder whether the frothy \     trademark yahoo! should be replaced with yahoo? to convey the \     uncertainty of purpose", "david carr @nyt"}      Note that the formatting is partial, not a global formatting selection (such as font) that affects the whole cell.


How to eliminate the need to double evaluate a Manipulate so that a Module in its Initialization section works?

Using V 8.04 on windows. _I think_ this issue might be related to the fact that Mathematica reads main body the Manipulate before evaluating or running the Initialization option. Or, might be related to, and I quote "Symbols (and their contexts) are created when parsing, not evaluation" as per this question at SO Too complicated for me to figure it. I have a Manipulate with a Module in its Initialization section. I find that I need to evaluate the cell which Manipulate is in **2 times** to get the correct behavior (ie. have all symbols fully evaluated) There might be also a way to go around this using Leonid idea shown here but I can't use this method, if it applicable here, as it uses a BeginPackage which is not allowed for my setup. Since the code used will be in a CDF/demo, these are the symbols I had errors using before and I can't use in a demo: `SetOptions`, `ToExpression`, `Symbol` , `$Context`, `SetAttributes`, `Clear`, `Unprotect`, `DownValues`, `UpValues`, `OwnValues` and packages not allowed to be used or created. Also, `Manipulate[]` has to be the most outside construct. Now, here is the problem description. I Quit[] kernel, and clear everything               Remove["Global`*"]      Then in new cell I evaluate this Manipulate               Manipulate[      x;      init[obj];      get[obj],           Button["run", x++],      {x, None},      {{obj, makeObj[]}, None},      TrackedSymbols :> {x},           Initialization :>       {               makeObj[] := Module[{obj, u},          init[obj] ^:= u = {1, 2, 3};          get[obj] ^:= {u, Date[]};          Return [obj]          ]               }           ]      which gives this output ![enter image description here](http://i.stack.imgur.com/qzcsH.png) You can see that the value of symbol u is not evaluated. Now I go back the Manipulate cell, and evaluate it again (Hit ENTER in the cell) and now I see ![enter image description here](http://i.stack.imgur.com/AAsxZ.png) So, **it takes 2 evaluations** to have this work as expected. Is there a way to make this setup work with one evaluation? * * * ## **Update (1)** This is my finding comparing the 3 methods below to try to see which one will work for me best. First, the 3 methods solve the above problem for me. Next, I looked to see which method works best when I make a copy of the code, to see if the new copy will share anything with the old copy of Manipulate, as this is important issue in making demos. To do that, I modified the above Manipulate example a little to make it return the object itself (obj$nnnn) so I can see if it is named differently or not in the new copy, and also added a counter to see if changing the counter in one copy will update the counter in the other. Below are the 3 Manipulate example codes, one for each method, and below that I show a result of what I found from the test: Method 1 (Kugler method)               Manipulate[x;      get[obj],      Button["add to counter", x++],      Button["zero the counter", init[obj]],      {x, None},      {{obj, makeObj[]}, None},      TrackedSymbols :> {x},      Initialization :>       {        makeObj[] := makeObj[] = Module[{obj, u = 0},           init[obj] ^:= u = 0;           get[obj] ^:= {obj, u++, Date[]};           obj           ]        }      ]      Method 2: (Faysal method):               Manipulate[x;      get[obj],      Button["add to counter", x++],      Button["zero the counter", init[obj]],      {x, None},      {{obj,        makeObj[] := Module[{obj, u = 0},          init[obj] ^:= u = 0;          get[obj] ^:= {obj, u++, Date[]};          obj          ];        makeObj[]        }, None},      TrackedSymbols :> {x}      ]      Method 3: (Albert method)               Manipulate[x;      get[obj],      Button["add to counter", x++],      Button["zero the counter", init[obj]],      {x, None},      {{obj, None}, None},           TrackedSymbols :> {x},           Initialization :>       {        makeObj[] := Module[{obj, u = 0},          init[obj] ^:= u = 0;          get[obj] ^:= {obj, u++, Date[]};          obj          ];        obj = makeObj[];        init[obj];        }      ]      **Testing method and results:** Before running each test, I did               Remove["Global`*"]      Then evaluated the Manipulate cell, then clicked on the add counter to make it go to 10, then made a copy of the Manipulate output to a new cell (copy/paste). Then looked to see what shows up in the new copy, and if the new symbol will have zero as value, as that is the initial value for it, or not, and if the symbol name will be different as well. The results is: Method(1) and method(3) generate a new symbol. But With method (1), this happens only when I click the button on the first Manipulate to increment it one more time. Initially both output had the same obj$nnn value. Method (3), did not have this issue. The new copy immediately showed zero as value of the symbol, and also new symbol name obj$mmm. I was surprised, because I thought Method(2) since Module is inside Manipulate it will have a new symbol when I make a copy. Learned something new today. This screen shot shows the results. Therefore, Method (3) will work best for me in a demo, as it is a requirement that new copy of Manipulate do not interact with old one. ![enter image description here](http://i.stack.imgur.com/oQYlT.png) Thanks to everyone for their help, I learned from all of these answers.


I'd like to display field lines for a point charge in 3 dimensions. Not a force field (short arrows) but continuous field lines that start on the charge.


How to draw a coordinate system diagram?

I want to make drawings like these in _Mathematica_ : ![sc](http://i.stack.imgur.com/aj7y0.jpg) ![enter image description here](http://i.stack.imgur.com/5lxoz.jpg) I don't know if _Mathematica_ is a gppd solution for drawing such images. If it is, please tell me how to do it; if not, please suggest another solution.


How to Keep Input Cells Hidden After Evaluating Notebook

I've created a notebook for use in an in-class presentation. There is a fair amount of MMA code, and my students know nothing about MMA nor do they need to. I don't want to distract them with the code. I understand how to collapse the input cells and show only the output, but the input cells expand whenever I evaluate the notebook so I'm back to where I started. This notebook is meant to be interactive, so it has to be evaluated whenever I change the input. In this case, I have an InputField that requests a ticker symbol and then the code uses FinancialData to get the data and from that creates the results. I've tried creating a slideshow, but that has the same behavior. I've looked at the resources and answer in "Best way to give presentations with Mathematica" without finding any mention of this issue. So, in MMA 8.04 is there any way to force the input cells to stay hidden after the notebook is evaluated? Surely, there must be an option for this somewhere.


FeynCalc "May shadow or be shadowed by other definitions"

So I've downloaded the latest FeynCalc from this site and put the extracted folder in `user/me/library/Mathematica/application`, but when I write the command               << HighEnergyPhysics`FeynCalc`      _Mathematica_ says a bunch of lines saying stuff like: > `FeynAmp::shdw:` Symbol FeynAmp appears in multiple contexts > {`FeynArts``,`HighEnergyPhysics`FeynCalc`FeynAmp``}; definitions in context > `FeynArts`` may shadow or be shadowed by other definitions. >> Anyone know what to do, how to install FeynCalc on a Mac properly? I'm using _Mathematica_ version 8.


Plotting All Possible Points Belonging to a Group Orbit

Given that $$X = \\{(x,y,z) \in \mathbb{R}^3 |\, x^2 + y^2 + z^2 - 2(xy + xz + yz) = k\\}\,,$$ where $k$ is a constant. Also given that a group $G$ is represented by $$\langle g_1,g_2,g_3|\, g_1^2 = g_2^2 = g_3^2 = 1_G\rangle\,.$$ $G$ acts on $X$ such that $$g_1 \cdot (x,y,z) = (2(y+z) - x,y,z)\,,$$ $$g_2 \cdot (x,y,z) = (x,2(x+z)-y,z)$$ and $$g_3 \cdot (x,y,z) = (x,y,2(x+y)-z)\,.$$ So given $(x_0,y_0,z_0) \in X$, how do I go about plotting the orbit of the point $(x_0,y_0,z_0)$, ie $$\\{g \cdot (x_0,y_0,z_0) \,|\, g \in G\\}\,,$$ on a 3D graph? Would `ListPointPlot3D` be useful to plot all the points? How about other plotting functions?


The only usage for the option InterpolationOrder in NDSolve is to be set to All?

We know that changing the option `InterpolationOrder` in `ListLinePlot`、`ListPlot3D`、`ListContourPlot` will change the shape of the curve:               (*A example from the help*)     data = {{0, 0}, {1, 2}, {3, 4}, {4, 2}, {6, 0}};     Table[ListLinePlot[data, InterpolationOrder -> n], {n, {0, 1, 3}}]      ![Mathematica graphics](http://i.stack.imgur.com/KLxc6.png) But nothing changes for NDSolve:               Table[Plot[Evaluate[First[x[t] /. NDSolve[{x'[t] == y[t], y'[t] == -x[t], x[0] == 1,              y[0] == 0}, {x, y}, {t, 0, 10}, InterpolationOrder -> n]]], {t, 0, 10}], {n, 1, 3}]      ![Mathematica graphics](http://i.stack.imgur.com/AsyM8.png) I checked the help and found the only example for `InterpolationOrder` in `NDSolve` is to set it to `All`. (The same example appears in two different places…) So I met the question written in the title, and, what if I want to change the `InterpolationOrder` of the `InterpolatingFunction` worked out by `NDSolve`? * * * (Sigh…) Seems that `InterpolationOrder` in `NDSolve` is really "useless", and there's no option that can change the interpolation order of `InterpolatingFunction` worked out by `NDSolve`…whatever! here I've already picked up another approach for changing the order: I just need to replace the `InterpolatingPolynomial` with `Interpolation[…, InterpolationOrder -> …]` in the link.


How to leave function unevaluated programmatically?

Is it possible to write a function in such manner, that it can be either evaluated or left unevaluated? This is a general question. Sample below is just a sample. No need to find solution for this sample. Need a general solution. Hypothetical sample:               F[x_] := If[x>=0,         Sqrt[x],         Fail[]     ];      So that it gives               F[4]     (* ==> 2 *)      But               F[-4]     (* ==> F[-4] *)      I.e. hypothetical function `Fail[]` stays for "drop evaluation and leave expression unevaluated". I know I can use `Condition`               F[x_] := Sqrt[x] /; x >= 0      But I wish to do that in imperative programming way. Is this possible? **UPDATE** I don't understand why this is not working:               F[x_] := Block[{fail},       (If[x >= 0,          fail = False;          Sqrt[x],          fail = True          ]) /; ! fail]      **UPDATE 1** Manual has a good example               f[x_] := Module[{a}, a = Prime[10^x];       (FactorInteger[a + 1]) /; a < 10^6]      which is checking internal variables, not arguments. But why my version above not works then?


Implementing a For (?) or series or loop (?) for individual results for every x to n

I'm working on improving a modeling formula and have spreadsheets worth of data to use, but my work so far has been quite tedious. I'm essentially pulling 20 rows of data from each separate sheet of a spreadsheet to put through the new formula, and I'm having to do a cell evaluation for each row rather than a single evaluation per sheet. As I said, it's getting tedious. These can be declared first:               a = 0;     m = 34;     sheet = 1; (* which sheet of the spreadsheet I'm pulling from *)     r = 2; (* the first row I pull from *)     w = 8;     d = 4;     ex = .591;      For each sheet, these values (except `r`) will be the same (as I'm having to change `r` twenty times for each sheet). I then have this:               gs = Import["filename", {"Data", sheet, {r}, {6}}] + a     ga = Import["filename", { "Data", sheet, {r}, {7}}]      Here I pull the data from the sheet and row declared earlier, from static columns 6 and 7. From here, it's just plugging this data into the components of the formula:               y = ((gs + ga)/m)^ex     k = Gamma[1 + 1/y]     gsa = (gs/m) + 0.5     gaa = (ga/m) + 0.5     new = m*((3*N[Sum[-((Exp[-((k (c + 1))/gsa)^y] - Exp[-((k* c)/gsa)^y]) (1 -                   Exp[-((k* c)/gaa)^y])), {c, 0, w}], 40]) +          N[Sum[(Exp[-((k (c + 1))/gsa)^y] -               Exp[-((k* c)/gsa)^y]) (Exp[-((k (c + 1))/gaa)^y] -               Exp[-((k* c)/gaa)^y]), {c, 0, d}], 40])     final = Ceiling[new]      Redundant statements: as of right now, for every row I want to import, I have to manually adjust `r` for each evaluation. That's 20 tedious adjustments per sheet, and while it takes all of, like, ten seconds to then record the `final` value and increase `r` by 1, it's just not a feasible way of churning through volumes and volumes of data. Is there a way to split this into two cells, with the first declaring everything before `gs`, and the second giving the value of `final` for each `r` from 2 to 21? This would, quite honestly, be a 20x time saver. I'm just too unfamiliar with _Mathematica_ (still on the trial, licensing when it expires) to figure out the matrix or loop (?) to save me the time. Any help would be so, so, so appreciated.


How to get better quality EPS graphics

Yesterday, I was doing any Tables of 15 graphs similar to the next example, to save .eps and use in latex. In the generation of the graphs Mathematica spends many time. Is possible to reduce this time, and work for the cpu? I found that Mathematica save .eps with a big (not necessary) size. between 4 and 5 MB. When it´s obvious that for this image 400 or 500 KB is enough. So... how to obtain eps from MAthematica with a reasonable size (10-20% of the size that I have commented) In this example               ContourPlot[peaks[x, y], {x, -2, 2}, {y, -2, 3},       ColorFunction -> "DarkRainbow", ContourLines -> False,       Contours -> 25, LabelStyle -> {Bold, 20},       Epilog -> {Black, PointSize -> .036, Point[ {{1, 2}, {1.5, 2.5}}],         Cyan, PointSize -> .036, Point[ {{-1, 2}, {-1.5, 2.5}}]},       ImageSize -> 300]      Yesterday I resolve the problem, saving jpg/png and converting to .eps to can use in latex, because I put 12 or 15 images per page, and don´t need a high quality, but I would like any solutions to this issue.


What exactly happens when adding a Blank after a built-in function used in the rules of ReplaceAll?

Well, this question is just for curiosity, personally I never use `ReplaceAll` like this:               Cos[2 x] /. Sin_[2 x_] -> 2 Sin[x] Cos[x]     (* => 2 Cos[x]^2 *)      How to explain the result?


Specifying view angle of a 3D plot

I would like to create a stereogram from a 3d plot; I would like to export two images of a 3d plot at a slightly different angle, so that when each picture is presented to a different eye, one gets the feeling it is actually 3 dimensional. I have tried to put two plots next to eachother, then turn one plot slightly by hand (mouse), but when I then export, it is as if I hadn't turned the plot at all! example:               s1 =        Plot3D[PDF[MultinormalDistribution[{0, 0}, {{1, 1/2}, {1/2, 1}}], {x, y}],         {x, -2.3, 2.3}, {y, -2.3, 2.3}]     Show[GraphicsArray[{s1, s1}]]      How can I specify at which angle the 3d plot is exported? PS: Just to be clear: I don't want to rotate the function which is plotted, I want to rotate the plot, including the edges of the bounding box of the plot.


Type Vietnamese in Mathematica

I type Vietnamese using UTF-8 Encoding but Text Display got error. How to type Vietnamese, Chinese in Mathematica. Please help me.


What's the correct method to simplify exponentials?

I have a sum of exponentials that I'd like to simplify. The issue is when I use `Simplify`, Mathematica loves to factor out one exponential factor. See below: $$e^{-i (d (\text{kx1}+\text{kx2})+2 \beta +\gamma +\delta +\text{$\theta $1}+\text{$\theta $2})} \left((e^{i (d (\text{kx1}+\text{kx2})+2 \beta )}+2 e^{i (d (\text{kx1}+\text{kx2})+2 \beta +\gamma +\delta )}+e^{i (d (\text{kx1}+\text{kx2})+2 (\beta +\gamma +\delta ))}+2 e^{i (d (\text{kx1}+\text{kx2})+2 \beta +\gamma +\delta +2 \text{$\theta $1})}+e^{i (d (\text{kx1}+\text{kx2})+2 (\beta +\text{$\theta $1}))}\right....))$$ Otherwise, when I try to `Expand` it I get $$e^{i (d (\text{kx1}+\text{kx2})+2 \beta )-i (d (\text{kx1}+\text{kx2})+2 \beta +\gamma +\delta +\text{$\theta $1}+\text{$\theta $2})}+2 e^{i (d (\text{kx1}+\text{kx2})+2 \beta +\gamma +\delta )-i (d (\text{kx1}+\text{kx2})+2 \beta +\gamma +\delta +\text{$\theta $1}+\text{$\theta $2})}+e^{i (d (\text{kx1}+\text{kx2})+2 (\beta +\gamma +\delta ))-i (d (\text{kx1}+\text{kx2})+2 \beta +\gamma +\delta +\text{$\theta $1}+\text{$\theta $2})}+2 e^{i (d (\text{kx1}+\text{kx2})+2 \beta +\gamma +\delta +2 \text{$\theta $1})-i (d (\text{kx1}+\text{kx2})+2 \beta +\gamma +\delta +\text{$\theta $1}+\text{$\theta $2})}+e^{i (d (\text{kx1}+\text{kx2})+2 (\beta +\text{$\theta $1}))-i (d (\text{kx1}+\text{kx2})+2 \beta +\gamma +\delta +\text{$\theta $1}+\text{$\theta $2})}$$ Any help on how to "simplify" correctly would be greatly appreciated. Note, `Refine` does nothing in my case.


WebServices context problem

I'm using two web services from the same host: Earth Orientation Center I can get each one to work on a fresh kernel but I cannot get both of them to work during the same instance of the kernel. I think this is a context problem so I have tried loading each one into their own context. **The Code** Instal the service:               Needs["WebServices`"]          InstallService["http://hpiers.obspm.fr/eop-pc/webservice/server_MATRICE_EOP.php?wsdl"]      Make a call:               year = 2005;     month = 12;     day = 31;     hour = 12;     minute = 34;     seconde = 34;     pm = 1;     ut = 1;     nut = 1;     tides = 1;          wservice =       MATRICEfromDate[      LaDate["theyear" -> year, "themonth" -> month, "theday" -> day,       "thehour" -> hour, "theminute" -> minute, "thesecond" -> seconde,       "thepm" -> pm, "theut" -> ut, "thenut" -> nut,        "thetides" -> tides]]      This works and I get a matrix.               complexType$2200["a11" -> 0.318954, "a12" -> 0.94777,       "a13" -> 0.000580507, "a21" -> -0.94777, "a22" -> 0.318954,       "a23" -> 0.0000409354, "a31" -> -0.000146358, "a32" -> -0.000563244,       "a33" -> 1.]      But now if I install the other web service               InstallService["http://hpiers.obspm.fr/eop-pc/webservice/server_EOP2.php?wsdl"]      Then make a call:               year = 2005;     month = 12;     day = 31;          wservice =       C04fromDate[       LaDate["theyear" -> year, "themonth" -> month, "theday" -> day]]      It also works!               complexType$3424["MJD" -> 53735, "x" -> 0.053717, "y" -> 0.384245,      "UT1UTC" -> -0.661133, "LOD" -> -1.6*10^-6, "dX" -> 0.000228,      "dY" -> -0.000287, "xerr" -> 0.00014, "yerr" -> 0.000141,      "UT1UTCerr" -> 1.7*10^-6, "LODerr" -> 0.0000135, "dXerr" -> 0.000098,      "dYerr" -> 0.000091]      So what is my problem? When I go back an run the first function `MATRICEfromDate` I get:               SerializeSchemaInstance::children: Invalid children: thehour->12.      I cannot get both of them to work consistently in one kernel session. I think is has to do with the context of the `LaDate` **Edits** I have tried adding `AllowShortContext -> False` as was suggested. However, this did not work but it help open the door to a better understanding of the problem. I have now explicitly added a context:               InstallService["http://hpiers.obspm.fr/eop-pc/webservice/     server_MATRICE_EOP.php?wsdl", "First`", AllowShortContext -> False]          InstallService["http://hpiers.obspm.fr/eop-pc/webservice/     server_EOP2.php?wsdl", "Second`", AllowShortContext -> False]      I then call the web service with the following functions (I use the same inputs as above)               wservice =       First`MATRICEfromDate[       First`LaDate["theyear" -> year, "themonth" -> month,        "theday" -> day, "thehour" -> hour, "theminute" -> minute,        "thesecond" -> seconde, "thepm" -> pm, "theut" -> ut,        "thenut" -> nut, "thetides" -> tides]]      and...               wservice =       Second`C04fromDate[       Second`LaDate["theyear" -> year, "themonth" -> month,         "theday" -> day]]      The problem revolves to the context of `LaDate`. Here is a look at the variables in the two contexts:               ?Second`*          C04fromDate dYerr$2982 MJD$2946   themonth$2872 xerr$2967     complexType$2943 dY$2964 thedate$2939 theyear$2867 x$2949         dXerr$2979   LODerr$2976 thedate$2939$2987                           dX$2961  LOD$2958 theday$2877 UT1UTC$2955 y$2952      Notice there is no `LaDate`. Now look at the other context:               ?First`*          a11$2737 a23$2752 LaDate  thehour$2545 thesecond$2555     a12$2740 a31$2755 MATRICEfromDate theminute$2550 thetides$2575     a13$2743 a32$2758 thedate$2730 themonth$2535 theut$2565         a21$2746   a33$2761 thedate$2730$2766 thenut$2570     a22$2749 complexType$2734 theday$2540 thepm$2560        Here you will find the `LaDate`. Some how I need to get a `LaDate` into each context because they are different. Another attempt I have taken the two web servers and placed them in separate packages inside the `Begin["`Private`"];` section and then wrote a wrapper function which I exposed via `usage` and still no luck. I think I'm just going to parse old FORTRAN data files from the USNO


How to get the mean color of an artwork?

I got a piece of artwork in dimension of 20x20 pixels. I attempted to divide it into a 5x5 array of elements each of a smaller size of 4x4 pixels, and would like to find the mean color of the elements. I got the job done in a double for-loop. Is there a better way to do it? I need a faster way to treat much larger pieces. ![enter image description here](http://i.stack.imgur.com/U81QN.jpg)               Clear[avg]     avg = ConstantArray[0, {5, 5}];     image = Import["http://i.stack.imgur.com/ZZWEu.jpg"] ;     idata = ImageData[image];     ddata = Partition[idata , {4, 4}, 4] ;     For[i = 1, i <= 5, i++,      For[j = 1, j <= 5, j++,       avg[[i, j]] = Mean@Flatten[ddata[[i, j]], 1 ];       ]]     Image[avg]      This is what I got: ![Mathematica graphics](http://i.stack.imgur.com/b4gnW.png)


Random filling of L-length line with l-length segments

I have discrete L-length line filled randomly with 2-length segments so its cover line with gaps 0 or 1. So we can describe cover configuration as sequence of gaps such as {0,0,1,0,1}. How I can calculate the probability of any cover? I tried to do it using weighted graphs but it works only for small values of L < 30\. Increase the line length on 1 leads to 10-times increase in calculation time. Here is my slow code:               l = 2;     detach = Function[{cov, l}, s = Last[cov];      Table[Append[cov, Delete[ReplacePart[s, i -> l + Total[s[[i ;; i + 1]]]], i + 1]], {i, 1, Length[s] - 1}]];     getProbability = Function[{cov, l},        cc = NestWhile[Flatten[(detach[#, l] &) /@ #, 1] &, {cov}, Length@Last@Last@# != 1 &];        Total[Map[(Apply[Times, #]) &, MapThread[(p = Total[Select[#1, # >= l &] - l + 1];         If[ p === 0, 1, 1/p]) &, {cc,ConstantArray[ConstantArray[l, Length[First[First[cc]]]], Length[cc]]}, 2]]]      ];     Table[getProbability[{ConstantArray[0, i]}, l] // AbsoluteTiming, {i, l, 10}]          Output: {{0.031540, 1}, {0.000216, 2/3}, {0.000547, 7/15}, {0.002399, 34/105}, {0.013129, 638/2835}, {0.089803, 4876/31185}, {0.694457, 220217/2027025}, {6.223379, 6885458/91216125}, {63.263433, 569311642/10854718875}}      Here is example graph: ![enter image description here](http://i.stack.imgur.com/qguoU.png) Maybe it is possible to solve this problem using recurrence sequence or generating functions?


Equation Solving: Solution in terms of predefined functions

Is there a way that I can have Mathematica give me the solution of a problem it has solved in terms of functions that I have predefined? The specific problem I'm trying to solve is:               s = alp^2 (E0*mu1 + N01);     k = 1 - E^(-Pmax/s^2) + Sqrt[π*Pmax]/(2*s)*Erfc[Sqrt[Pmax]/s];          E1 = s^2 (1 - E^(-Pmax/s^2));          epsd = E1 - (s*k)^2;          A = 1 + epsd/((k*alp)^2 N01);          c = E1/(N01*(k*alp)^2);          SIG1 = (E0*mu1)/N01; SIG2 = (E1*mu2)/N02;          D[1 - 2 E^(-((A SNRth)/SIG1)) Sqrt[(c SNRth)/(SIG1 SIG2)]          BesselK[1, 2 Sqrt[(c SNRth)/(SIG1 SIG2)]], {alp}]      The solution given by _Mathematica_ is extremely lengthy. However, by observation it can be seen that many of the functions that I have defined above the differentiation operator are contained within the solution.


How to slice TimeSeries data?

When retrieving curated data, v10 now returns `TimeSeries` objects. For example,               ts = WeatherData["KP60", "Temperature", {{2013, 7, 1}, {2013, 9, 30}}]          DateListPlot[ts]      What is the most convenient way to extract a range from this temporal data, for example for plotting purposes? E.g. only plot the first two weeks of August from this data. I know I can simply convert it to a list using `Normal` and then use e.g. `Select` to filter. Is there anything better?


Convert expression to C-form and simplifying

I have an expression which is the sum of many terms of the form $$ \frac{0.00000000274341}{(0.000363856+(0.611425+z)^2)^{3/2}} $$ My problem is that I need to include this long expression in a C++-program I made, so all the exponents $^2$ and $^{3/2}$ I need to bring on a C++-compatible form. If I use `CForm`, then the exponents become `pow(..., 2)` and `pow(..., 1.5)`, respectively. In order to speed up my program, I would like for all the `pow(..., 2)` expression to be converted to `(...)*(...)` and for the `pow(..., 1.5)` to be converted to `(...)*pow(..., 0.5)`. Is there an easy way to do this?


Is it possible to compute trapezoidal rule numerical integration? I know that Mathematica has `Interpolation`, and that a list of points can be interpolated and then integrated simply using `Integrate`. However, my functions are highly oscillatory (they are based on simulation data), and I am not convinced that the interpolation is perfect, even when I set `WorkingPrecision` to a very high value. Also, I know that `ListIntegrate` is deprecated, and even if I use it, I am not certain if it is using the trapezoidal rule, which I would like to use. Do you know if any resources where I can find Mathematica or pseudocode for trapezoidal integration of lists of points? Or do you have any suggestions about how I can use Mathematica efficiently to program such an algorithm myself? Thanks!


Making a BarChart showing many data points look better

I have a `BarChart` used to show traffic on a network interface. I have data for every 0.5s, upto 1 min, which gives a lot of points. Is there a way to make it look less chaotic and messy?               data = Import["/Users/matek/NetworkTest/without_use_in_and_out.csv", "Table"];          maxValues = 121;     labelValues = Range[0.0, maxValues*0.5, 0.5];     Show[         BarChart[             data[[1 ;; maxValues]],             ChartLegends -> Placed[{"Outbound (TX)", "Inbound (RX)"}, {{0.5, 0}}],             ChartLabels -> {labelValues, None},             AxesLabel -> {"Duration [s]", "Bandwidth [byte/s]"}         ],          ImageSize -> 600,          BaseStyle -> {12, FontFamily -> "Helvetica"},          PlotRange -> All      ]      The result ![enter image description here](http://i.stack.imgur.com/IFboA.png) It's evident that the ticks and ChartLabels in the resulting BarChart look awful.


Stopping Evaluation of Manipulate after it goes through once

I do quite a bit of textual analysis with _Mathematica_ , and am currently making some `Manipulate` objects to walk people through key terms in the database. One issue I am running into with `Manipulate` however is that it continues to evaluate. For example, please consider the following code: ( **warning, this code does loop FWIW** )               testInput = {{"the", 4415}, {"of", 1284}, {"and", 1608}, {"in",          1384}, {"to", 1353}, {"a", 1205}, {"coal", 815}, {"was",          753}, {"by", 459}, {"were", 449}, {"for", 382}, {"is",          362}, {"with", 324}, {"from", 322}, {"on", 317}, {"that",          311}, {"as", 302}, {"mines", 264}, {"s", 257}, {"mining",          257}, {"it", 253}, {"this", 244}, {"at", 244}, {"be",          225}, {"cape", 216}};          testInput2 = {{"the", 4415}, {"of", 1284}, {"and", 1608}, {"in",          1384}, {"to", 1353}, {"a", 1205}, {"coal", 815}, {"was",          753}, {"by", 459}, {"were", 449}, {"for", 382}, {"is",          362}, {"with", 324}, {"from", 322}, {"on", 317}, {"that",          311}, {"as", 302}, {"mines", 264}, {"s", 257}, {"mining",          257}, {"it", 253}, {"this", 244}, {"at", 244}, {"be",          225}, {"cape", 216}};          files = {testInput, testInput2};          Manipulate[      viewerCount1 = {};      Do[       input = access;       AppendTo[viewerCount1,         If[Length[Flatten[Cases[input, {word1, _}]]] == 0, 0,          Flatten[Cases[input, {word1, _}]][[2]]]];       , {access, files}];      Print[viewerCount1];      , {{word1, "the", "First Word:"}}]      It goes through, runs the `Do` loop which picks out the word frequencies of `word1' in the sample text provided. But then, it **continues to loop**. It goes back through and does it again. And again. And again. This is all without any change to the `Manipulate` input. Is there a way to get to the end of the line `Print[viewerCount1]` and then **stop** until the input changes? I have tried to figure out the behaviour by looking elsewhere, such as "Manipulate Evaluation Sequence" and in the documentation, but there seems to be a paucity of textual examples like this.