Expanding derivatives of hypergeometric functions

Sometimes _Mathematica_ expresses results of integration or summation in terms of symbolic derivatives of `Hypergeometric2F1` function, and cannot further simplify these derivatives using `FunctionExpand` or `FullSimplify`. In some cases I was able to express those derivatives in terms of elementary functions and well-known mathematical constants, but it required some manual work and was on case-by-case basis. Now I have a table of about a hundred of derivatives I already dealt with and a function that can automatically replace them by their values. For example, it contains cases like               Derivative[0, 1, 0, 0][Hypergeometric2F1][-1/2, 3/2, 1/2, 1/Sqrt[2]] ==          (Sqrt[1 + Sqrt[2]] (Sqrt[2] Log[3/2 - Sqrt[2]] + 2 (Sqrt[2] + Log[2 + Sqrt[2]]))              - 4 Sqrt[2] ArcTan[Sqrt[1 + Sqrt[2]]])/2^(3/4)      and               Derivative[2, 0, 0, 0][Hypergeometric2F1][0, -3/4, 1, 1] ==          4 π/3 + 13 π^2/12 - 8 Log[2] - 3 π Log[2] + 9 Log[2]^2 - 8 Catalan      I wonder if anybody else tried to solve this problem and found a more general or automated approach to this? Or if anybody has a more comprehensive table of derivatives and is willing to share it? I can publish my table if anybody is interested (but I haven't kept all calculations that yielded those results).


Fraction of fibers that have failed

I have the following to set into mathematica. Assume a stress(sigma) applied on a specimen which has a number of fibers within it. All fibers that have a strength less than the applied stress should fail. I set a cumulative distribution of the fiber strengths with a mean and standard deviation. I want to use this cumulative distribution to tell me how many fibers are less than the applied stress which have failed and store this number somewhere. This procedure should be repeated until all fibers have failed. so there is a convergence in the two variables. I am new in mathematica so sorry for a vague question. thanks, Nick


Select words from different rows of column headings

I have a 2-dim array. The first 3 rows have column headings. The heading can be a single word, or 2 words (which take 2 rows) or 3 words (which take 3 rows). For each column I know which row has the most meaningful name for that column. I can't figure out how to map this and get what I want. For example:               a1 = {{"", "", "Class"}, {"Year", "Full", "of"}, {"Sold", "Amount",      "business"}};     a2 = {2, 3, 1};      I want my three headings to be "Year", "Amount", "Class", this is based on a2. I assume I can use Part to do this, and use Map with a LevelSpec. But I can't figure out how to make this work. Maybe I'm thinking in the wrong direction.


How to find a scaling parameter in matrix inversion process by MMA?

I simply would like to find the inverse of a given matrix $A$ by the iterative method $X_{k+1}=X_k(2I-AX_k)$ using $X_0=\frac{1}{\sigma_{max}^2}A^*$. An example is as follows               SeedRandom[123]; m = n = 500;     A = RandomReal[10, {m, n}]; Id = SparseArray[{{i_, i_} -> 1.}, {m, m}];     tolerance = 10^-6; max = 50; k = 0; R[0] = 1;     X[0] = (1./SingularValueList[A, 1][[1]]^2)*Transpose[A];     While[k < max && R[k] >= tolerance,       XX = A.X[k]; X[k + 1] = X[k].(2 Id - XX);       R[k + 1] = Norm[Id - X[k + 1].A, Infinity];       k++];     k     Table[R[l], {l, 1, k}]      As can be obsereved the number iterations is too high for a $500\times500$ matrix. What I want to do now is to scale this method by introducing the parameter $\alpha_k$ per cycle, i.e. $X_k<=\alpha_kX_k$. In fact, $\alpha_k$ must be computed adaptively so as to solve the following optimization problem $\|I-\alpha_kAX_k\|_2<\|I-AX_k\|_2$. In this way, we might be able to reduce the number of iterations. Note that $\alpha_k$ must rapidly tend to 1 in order not to cause instability. I will be thankful if anyone lend me a hand in caluculating the scaling parameter per cycle.


Loading and processing five files at a time from a directory containing many, many files

I have 3000 files (for example: aa101.csv, aa108.csv, aa120.csv, ...) and I need to process them. I need to load five files from a folder, process them, and export them to new list in Excel. Then I need to take another five files from the same folder and process them, and so on. I tried               printer[n_] :=        Module[{file = n},              calculation...         ...              Export[name <> ".xlsx", {data}, "Data"];       ]          printer[Import["E:\\mathematica\\a\\*", "text"]];      But `printer` loads all files from the specified folder. Could you please help me with this problem?


Getting FTSE indices in Mathematica

I'm not sure if this is the best StackExchange to post this question, but I figured it had more to do with the specifics of Mathematica than Quantitative Analysis so I've posted it here. Basically, I am trying to make a notebook in Wolfram Mathematica 9 which allows me to easily monitor and analyse share prices on the British FTSE 100,200 etc. stock exchanges; I know that Mathematica has the `FinancialData[]` function, and I was hoping to be able to use it for the FTSE markets. I have tried the following without success:               FinancialData["^FTAS","Members"]     FinancialData["^FTSE","Members"]      So I tried to look at the entire list of entities contained within `FinancialData` using:               FinancialData[]      However, this yielded a large list of indices and I was not able to find anything useful. The only reference I have managed to find on this was here, but as shown above I have tried this and only got the following output:               Missing["NotAvailable"]      Do I need to preload the british financial data in Mathematica at the beginning of my notebook, or is the data already there I just need to access it in a different way?


Implicitly differentiate an equation, then solve the resulting equation

Suppose I have an extremely tedious equation to differentiate and want mathematica to help do the differentiation and solve. Consider a less tedious equation: $$y (x,z) = sin \left(\frac{1}{x} \right) - \frac{1}{x} - z $$ Can mathematica find $\frac{\partial y}{\partial x} $ at $x=0.3$ by performing implicit differentiation on both sides and solving for $\frac{\partial y}{\partial x} $? Now suppose we try implicit differentiation: $$ sin (y) + y = sin \left(\frac{1}{x} \right) + xz$$ I want to find $\frac{\partial y}{\partial x} $ at $x=0.3$, $y=0.4$ and $z=0.5$ It should give a value of $5.94$. Tried this, but didn't work:               sin [y] + y == sin [1/x] + x z     D[y[x_, y_, z_], x] /. {x -> 0.3,  y -> 0.2, z -> 0.5}


How to make the MMA document has the background--color effect when the dounment is printed?

**_Description:_** Recently,I use the Mathematica to do my undergraduate paper,I would like to use the Mathematica to compose my paper. So I hope the Input and Output results have the `background--color effect` **_Question:_** How to do to achieve this effect?


Export Code to Pseudocode?

I'm writing a paper and all my code is in _Mathematica_. The snippets are mostly simple, and consist of loops, maps, variables, and conditionals. I'd like add it to my paper, however, not many academic journals accept verbatim code in a specific language, and I'm short on time, so here is my question: **Does anyone know of a package that translates _Mathematica_ functions and code to pseudo-code?** Of course there is no universal syntax pseudo-code, but I'll accept anything that is adequately general (bonus points for robust exportability to $\LaTeX$). Here are some examples of this utility in other languages:   * http://www.rapidqualitysystems.com/Products/CodeRocketEclipse   * http://www.bigresource.com/VB-Pseudocode-Generator-sjETRTxkP2.html When writing papers I always do the translation by hand, but enough is enough, _Mathematica_ should excel at a high-level translation problem like this and at least get the bulk of the work done for me! I use the pseudocode environment from the `fancybox` package to typeset pseudocode into $\LaTeX$. Please note that I fully intend on trying to write an answer to this myself, so don't down vote for the lack of code just yet! `:)`


Solving the Helmholtz equation in polar coordinates

I'm trying to (as a simple starter) find the solution to Helmholtz equation in polar coordinates -- I already know what it is and can derive it by hand, but just want to start here before asking _Mathematica_ to do it in more complex coordinates. Sample derivation from Wikipedia. My code:               pde2 = D[A[r, θ], {r, 2}] + D[A[r, θ], r]/r  + D[A[r, θ], {θ, 2}] / r^2 + k^2 A[r, θ] == 0          soln = DSolve[{pde2, A[a, θ] == 0}, A[r, θ], {r, θ}]      which I believe corresponds to: $$ A_{rr} + \frac{A_{r}}{r} + \frac{A_{\theta\theta}}{r^2} + k^2 A = 0 $$ with boundary condition $$ A(a, \theta) = 0 $$ One thing I'm wondering is that I'm not specifying $r \leq a$, but I can't work out how to do that. Any help, including links to documentation I've missed or misread will be greatly appreciated.


Convert operator to string

How to programmatically convert an operator such as `Equilibrium` into its displayed form as a string? The conversion should work like this:               FullForm[convert /@ {Equilibrium, LongRightArrow, LeftVector, Equal}]      ![Mathematica graphics](http://i.stack.imgur.com/sY9L8.png) I've tried various methods with no avail:   * converting to strings and wrapping in `"\\[...]"`   * using different form wrappers (`DisplayForm`, `TraditionalForm`, etc.)   * using low level boxes, but since that is really not my alley, I was a bit clueless   * since operators with built-in meaning are used too, argument usage does not seem viable (e.g. `ToString[Equal["", ""]]` which returns `True`)


updating code from 5.0 to 9.0

I am updating a code from a 5.0 version to a 9.0 version. I am speaking about "Advanced visual quantum mechanics". There is a package with this code: * * * `               VQMmsgon  = Head[General::"spell"]  =!= $Off;         VQMmsgon1 = Head[General::"spell1"] =!= $Off;          Off[General::spell1, General::spell];               (*-----------------------------------*)     BeginPackage["VQM`ArgColorPlot`"];     (*-----------------------------------*)         ClearAll[QArgColorPlot,QListArgColorPlot];          (*-----------------------------------*)     Begin["`Private`"];     (*-----------------------------------*)        If[!ValueQ[$UseListLinePlot],             $UseListLinePlot=True;     ];          Options[QArgColorPlot] := Sort @ {JoinOptions[             {             PlotStyle -> None             },             Options[ If[$UseListLinePlot, ListLinePlot, Plot] ],             {             Opacity -> 1,                      Compiled->True,              QSaturation->1, QBrightness->1, QBottomLine->0, QShiftPlot->0, QPlotDown->False,              QSquared->False             } ] };          Options[QListArgColorPlot] =  Sort @  Join[Options[QArgColorPlot],{QHorizontalRange->All}];          SetAttributes[QArgColorPlot,HoldAll];          QArgColorPlot[func_,{x_Symbol,xmin_,xmax_},opts___?OptionQ] :=         Module[{comp,plot1,opts1,xvars,yvals},             comp = Compiled/.Join[{opts}, Options[QArgColorPlot]];             If[comp === True,               abf = Compile[{x},Abs[func],{{func,_Complex}}];               fnc = Compile[{x},func,{{func,_Complex}}], (*else*)               abf = Abs[func];               fnc = Function[{x},func];             ];             opts1   = FilterRules[{opts},Options@Plot];             plot1   = Plot @@ { abf, {x,xmin,xmax},                                  {opts1} /. ( PlotStyle -> _ ) :> Sequence[]};             xvars   = First /@ Level[plot1[[1]], {5}];             yvals   = fnc /@ xvars;                 QListArgColorPlot[{xvars,yvals}//Transpose, opts]         ]/;NumericQ[xmin] && NumericQ[xmax]     EndPackage[]      ## `


Changing equations to be solved by NDSolve when an event is triggered

I am using NDSolve to solve a set of coupled differential equations. When a certain event occurs, I want two equations in the set to be changed radically, for example from `x'[t] == a*y[t] + b*y'[t], y[t] == c*x[t] + d*x'[t]` to `x'[t] == 0, y[t] == -f*y'[t]` For this purpose, I have first tried to use the trick shown in the Mathematica featured example for the ACDC Full Wave Rectifier. So I just wrote the equations like `x'[t] == go[t]*(a*y[t] + b*y'[t]), y[t] == go[t]*(c*x[t] + d*x'[t]) + (1-go[t])*(-f*y'[t])` and set events like `WhenEvent[{y[t] > y0 && go[t]==1}, go[t] -> 0]` `WhenEvent[{y[t] < y0 && go[t]==0}, go[t] -> 1]` to jump back and forth between the two pairs of equations I want to use each time the event is triggered. However, two 'division by zero' errors occur (I assume it's because NDSolve is still trying to solve the parts multiplied by zero). So apparently this method does not work for this type of problem. Anybody knows the 'right' way to do this?


Random variates in Recurrence Function

I'm completely new to Mathematica and can't seem to find an answer elsewhere so hopefully I can get some help here. I'm trying to plot a recurrence relation, where a random variate is generated at each iteration of the recurrence. From looking at the output, it appears as though the RandomVariate evaluates to a constant at each iteration. I have this inside a 'manipulate' block:               ListLinePlot[        RecurrenceTable[{S[i] ==         S[i - 1]*        Exp[(r - (vol^2/2.0))*T/N +           vol*RandomVariate[NormalDistribution[μ, σ]]*           Sqrt[T/N]], S[1] == S0}, S, {i, 2, N}]]}]      Any help with what I'm trying to accomplish would be appreciated. Edit: here's the full version                Manipulate[      Column[{      Plot[{PDF[ NormalDistribution[μ, σ], x],                    PDF[ JohnsonDistribution["SU", γ, δ, μ, σ], x]}, {x, -6, 6}, Filling -> Axis],     ListLinePlot[     RecurrenceTable[{S[i] ==         S[i - 1]*         Exp[(r - (vol^2/2.0))*T/N +            vol*RandomVariate[NormalDistribution[μ, σ]]*            Sqrt[T/N]], S[1] == S0}, S, {i, 2, N}]]}],     Style["Distribution Parameters", 12, Bold],      {{μ, 0}, -5,   5},      {{σ, 1}, 0.1,  5},      {{γ, 1},    1, 10},      {{δ, 1},    1, 10} ,      Delimiter,      Style["Option Parameters", 12 , Bold],      {{N, 10}, 10, 1000},      {{T, 1/12}, 1/12, 1},      {{vol, 0.2}, 0, 1.0},      {{r, 0}, 0, 0.3},      {{q, 0}, 0, 0.3},      {{S0, 100}, 0, 1000},      ControlPlacement -> Left]


Is there a notebook autosave frequency configuration?

I've had Mathematica crash on me a number of times, and have had to recreate notebook contents from the last save point. I was looking for something in the preferences like an autosave frequency configuration parameter that I could use to automatically save all my notebook content at some regular frequency to minimize losses due to crashes. I found `NotebookSave[]`, and a `NotebookAutoSave -> True` attribute for `CreateDocument`, but both these appear to be for manipulating external notebooks. Is there a way to do this systematically and by default?


Error bar plot - no bars but rather point size determined by errors

Looking for a way to create an `ErrorListPlot` `(x,y,error)` with the radius of the `PlotMarker` determined by the magnitude of the error (which in my case is symmetrical), no actual error bars desired. I want the size of the points to reflect the standard deviation of the datum, rather than `Small,`Large`or any`AbsolutePointSize` values. I can probably approach this a variety of ways (`BubbleChart`, `ListPlot` with custom `PlotMarkers`, or `ErrorListPlot` with custom `ErrorBarFunction`) but I can't make progress. All of my efforts are being foiled by the relative scaling of `PlotMarkers` to the width of the plot, rather than the magnitude of the data values.


How to reverse the gradient and ticks in BarLegend

I created a plot with a horizontal BarLegend for TemperatureColors (see1). Code:               PlotLegends ->           Placed[BarLegend[{"TemperatureMap", {15, 30}},Ticks -> Table[i, {i, 15, 31, 1}], LegendMarkerSize -> 300,             LegendLabel -> "T(\[Degree]C)",             LabelStyle -> {Bold, Black, 11}], {Bottom, Center}]       Now I just want to have the BarLegend having the temperatures on it decreasing from left to right, means values and colors reversed with high temperatures on the left. ![enter image description here](http://i.stack.imgur.com/0d9Jk.jpg)


plot data differences

I have the following data:               data12 = {        {1, 981.946, 978.783, 978.783},        {2, 813.948, 810.783, 810.667},        {3, 743.422, 743.447, 744.062},        {4, 715.382, 715.478, 715.326},        {5, 690.345, 696.075, 691.664},        {6, 862.126, 870.902, 860.371}     };      I want to make a `ListLinePlot` using the first row element (the index) as the X coordinate, and for the Y coordinate, the difference between the second and third value in row (generally speaking, the difference between two generic columns). How can I do it? Thanks in advance for your reply. === EDIT === I've found this solution:               ListLinePlot[{#[[1]], #[[2]] - #[[3]]} & /@ data12]      Is it a good solution, or is there a better way to accomplish this?


Hyperlinks not preserved when saving in PDF format in MMA V10

I usually create my course contracts in Mathematica and then save them in PDF format. The notebooks include hyperlinks and these have transferred to PDF without problem over the last several versions of Mathematica (at lease 7, 8 an 9). Is there something different that I need to do in version 10 in order to preserve hyperlinks? I tried `SetOptions[$FrontEndSession, PrintingStyleEnvironment -> "Working"]`. But this only changed font sizes.


Export Plots to PNG in Printout Style

When creating a plot in Mathematica 10 (OS X 10.9.4 and Win 7) the FrameLabel and Ticks are greyish and only the Frame itself is black (see Screenshot bellow). Only when exporting the plot to PDF all elements are black. However when I try to export the plot to PNG, then the resulting PNG looks exactly like the screenshot. Is there a way to use the _Printout style_ (as is used when exporting to PDF), when exporting plots to raster graphics (bitmap) formats such as PNG? Plotting:                plot = Plot[x^2, {x, 0, 3}, Frame -> True,       FrameStyle -> Directive[Thick, FontSize -> 24],       FrameLabel -> {"x", "y"}]      and Exporting:                Export["plot.png", plot];      Export["plot.pdf", plot];      ![Comparison](http://i.stack.imgur.com/njQ5E.png)


A code deal with Lists operation ---Needs optimizion

I have written some code to deal with lists, But the speed of the code is slow, Could Someone help me to speed up it? Probably could rewrite it with Functional Programming! Give me some ideas! The whole code is located on Find sublists of a list match conditions (2)               CountTrue[list_] := Module[                {},                Count[list, True] >= 1                ];                  ProjectedElemsIndex[ElemPtsCoord_, ElemElemsMadeofPtsIndex_, Acen_,                 Bcen_, Ccen_, R1_, RetainElementsIndex_] := Module[                {RELPtsIndex, temp1, temp2},                     RELPtsIndex = ElemElemsMadeofPtsIndex[[RetainElementsIndex]];                     temp1 =                  Reap[Do[Sow[  ElemPtsCoord[[RELPtsIndex[[i]]  ]] ], {i, 1,                      Length[RELPtsIndex]} ] ][[2, 1]];                temp2 = Table[Table[{Acen, Bcen, Ccen}, {4}], {Length[temp1]}];                     Flatten[                 Position[                  Map[                   CountTrue,                   Negative[                    Map[Norm, temp1 - temp2, {2}] -                      Table[Table[R1, {4}], {Length[temp1 - temp2]}]                    ]                   ],                  True]                 ]                     ];              Length[ProjectedElemsIndex[ElemPtsCoord, ElemElemsMadeofPtsIndex, 40,             40, 40, 10, RetainElementsIndex]] // Timing


How to visualize a function with four arguments?

If I have a function, `f[a, b, c, d]`, with a, b, c and d varying between 0 and 1 continuously. What would be the best way to explore this function visually with _Mathematica_? Is evaluating multiple `Plot3D` expressions with two of the four arguments held constant my only option?


How to speed up minimization of function

I have the fallowing code (the functions within that code are replaced by simpler ones, but the code structure is identical): $$$$               g[x_, y_, z_] := x^2 + y^2 + z^2;     f[x_, y_, z_] := (buffer = Minimize[g[x, y, z], x];        xmin = x /. buffer[[2]];        g[xmin, y, z]);          Plot3D[f[x, y, z], {y, 0, 4}, {z, 0, 4}, PlotPoints -> 2]         It takes my computer about 7 seconds to process that code. With my actual functions it takes several minutes. This is only one step in a longer chain of steps my program needs to process. Is there a way to speed that step up? Maybe something faster than using the function Minimize. $$$$ $$$$ If i modify my code like this:                g[x_, y_, z_] := x^2 + y^2 + z^2;      f[x_, y_, z_] := (buffer = Minimize[g[x, y, z], x];            xmin = x /. buffer[[2]];            g[xmin, y, z]);         Plot3D[f[x, y, z], {y, 0, 4}, {z, 0, 4}, PlotPoints -> 2,                  RegionFunction -> Function[{x, y, z}, x + y < 3]]      $$$$ The result is what i want, but it actually takes more time, even though in the resulting plot are less data points. I assume mathematica plots first my function and then it cuts with RegionFunction in my plot. Is there a way to make Mathematica just plot the resulting area and not plot the area that is later cut out anyway? I've tried it like this:                g[x_, y_, z_] := x^2 + y^2 + z^2;      f[x_, y_, z_] := (buffer = Minimize[g[x, y, z], x];            xmin = x /. buffer[[2]];            g[xmin, y, z]);         Plot3D[f[x, y, z], {y, 0, 4}, {z, 0, 4 - y}, PlotPoints -> 3]      $$$$ But the resulting plot doesn't exactly look like the one resulting using RegionFunction, it looks abit more 'bumpy'. So i've increased the PlotPoints from 2 to 3, then the resulting plot looks pretty much like the one with RegionFunction. But the Problem is, now plotting takes longer then with RegionFunction ;) $$$$ Thanks for your help. $$$$ $$$$ Your answeres (using the function Evaluate[]) helped me solve the problem for the above described situation. However it does not work with my actual functions, so i have to write them down here after all.               bindeaa[e0_] := e0;     c[e0_] := 40 e0;     bindeab[e0_] := 1.27 e0;           alpha[gamma_, p_, epsilon_] := p (gamma  - epsilon);     beta[b_, epsilon_, n2_] := b epsilon^2 n2^(3/2);                 eisl[b_, e0_, g_, gamma_, p_, epsilon_, n2_, x_] :=                  g c[e0] (epsilon)^2 - bindeaa[e0] +                  e0 ((-2 Log[E^(1/2) x])/x^2 + alpha[gamma, p, epsilon]/x +                  beta[b, epsilon, n2]/x^(3/2));               eislminx[b_, e0_, g_, gamma_, p_, epsilon_, n2_]:=      (minxzwischen = FindMinimum[{eisl[b, e0, g, gamma, p, epsilon, n2, x], 0 < x},x];                   minx = x /. minxzwischen[[2]];                             eisl[b, e0, g, gamma, p, epsilon, n2, minx]);           Plot[eislminx[10, 1, 0.7, 0.3, 4.9, 0.05, n2], {n2, 0, 10},       PlotPoints -> 2, Evaluated -> True]      Mathematica gives the following error messages: FindMinimum::nrgnum: The gradient is not a vector of real numbers at {x} = {1.}. >> FindMinimum::nrgnum: The gradient is not a vector of real numbers at {x} = {1.}. >> FindMinimum::nrgnum: The gradient is not a vector of real numbers at {x} = {1.}. >> General::stop: Further output of FindMinimum::nrgnum will be suppressed during this calculation. >> ReplaceAll::reps: {x} is neither a list of replacement rules nor a valid dispatch table, and so cannot be used for replacing. >> ReplaceAll::reps: {x} is neither a list of replacement rules nor a valid dispatch table, and so cannot be used for replacing. >> What is the problem here?


Solve prints message saying that it cannot solve my equation

I want to solve the fallowing equation:               Solve[-(2/x^3) - 1/x^(5/2) - 1/x^2 + (4 Log[Sqrt[E] x])/x^3 == 0, x]      _Mathematica_ complaints: > This system cannot be solved with the methods available to Solve Does anybody know how to circumvent this problem?   Maybe there is a clever approximation of the `Log[x]/x^3` term?


How to create a CDF "on the fly"?

I don't know if I have asked the question the right way: **As CDF is essentially a simple text file, I would like to create it "on the fly" without saving it to the hard drive.** I would like to give a little bit of background: I process SQL data within Mathematica an create a little CDF containing some animated graphics and tables. Currently, the process is triggered from the SQL server and the resulting CDF is saved back to the database in compressed, binary form. The CDF is embedded into the web application as a popup. This is my code (example):               deployobj =        Manipulate[        Column[{Rationalize[Pi, 10^-n], N[Rationalize[Pi, 10^-n], 48],           N[Abs[Pi - Rationalize[Pi, 10^-n]], 48]}, Frame -> All,          Spacings -> 1.5], {n, 0, 10, 1}, FrameMargins -> 50,         Deployed -> True, SaveDefinitions -> True];     file = ToFileName[{$TemporaryDirectory}, "CDF_Embedded.cdf"];     CDFDeploy[file, deployobj];     fnMyExportToSQLFunction[Import[file, "Text"]]      The code works well. Is there any way to create the CDF "on the fly" without saving it to the hdd? Thanks!


Problem with UpdateInterval

I want to monitor current results with `Dynamic`               ls = {}; k = 1;          Dynamic[      Refresh[        AppendTo[ls, k++];        Last@ls     , UpdateInterval -> 10]]      For some reason output updates instantaneously and not every 10 seconds


How to simulate the 1-D motion of a particle under constant acceleration?

I am trying to represent the position of an object under freefall, but am completely lost. Here is my attempt so far:               time = 0;     increment = 10;     distance := 0 - time*(time*increment);           {Dynamic[Refresh[{time++ 1, ClockGauge[DateList[]]}, UpdateInterval -> 1]],      Dynamic @ distance,       Dynamic @ Framed[Graphics[Disk[{0, distance}, 10],                                 PlotRange -> {{-2, 2}, {1, -1000}}]]}      Which results in: > ![enter image description here](http://i.stack.imgur.com/2cA7R.png) The bar on the left should represent the position of the object under freefall, and the number to the right of the bar should represent its _y_ coordinate. **However this clearly accelerates way too fast way too soon**. Basically the main problem here is that I don't know how to translate the '10m per second per second' into a language that _Mathematica_ can understand. Could someone help me with what formula to use?


Solve not satisfying simple boundary conditions

I am trying to solve the following equations for the coefficients `c1` and `c2`.               w[x_] := c1*(1 - x)       a[x_] := c2*(1 - x)      Given the constraints:               Solve[(1 + w[x]*a[x]) == (1/x) && w[0] == wmax && a[1] == 0 , {c1, c2}]      Mathematica gives me:               {{c1->wmax,c2->1/((x-x^2) wmax)}}      However when plugging the formula for `c2` into `a`, the condition `a[1] == 0` is not satisfied. Instead of being zero, `a[1] == 1/wmax`. How can I convince `Solve` to generate a `c2` that truly makes `a[1] == 0`?


How to export a large number of files?

I have a lot of data sets combined in a big list where each data set comprises one first level sub-list. Each data set must be saved into a separate file. The names for the files must automatically assigned during export. **How to export different files at the same time?** The basic form of `Export` is `Export["filename.ext", expr]`, I have not been able to adapt this basic for a sequence of file names, because I don't know how modify the string "filename.ext" to include a sequence number. How could I do that? I want to generate ten file names using a loop to export the data automatically. I was thinking maybe an expression like               Do[Export["filename[[n]].txt", data[[n]]], {n, 1, 10}]      where the filename is a list `{name_1, name_2, name_3, .., name_10}`


FindRoot with vector functions

I'm trying to solve a system of non-linear equations with `FindRoot`, and I get the answer, but also a > >     *partd* (part spec longer than depth of object) >   error. This throws me off and makes me think it's poor programming. Is there a way to code this such that I don't get this message?               Clear["Global`*"]     F[x_] := {x[[2]]*x[[3]], -x[[1]]*x[[3]], -0.51 x[[1]]*x[[2]]}     dt = 0.1;     xi = {0, 1, 1};     xj = {x[1], x[2], x[3]};     FindRoot[xj == xi + dt*F[xj], {xj, xi}]          Part::partd: "Part specification xj[[2]] is longer than depth of object."     Part::partd: "Part specification xj[[3]] is longer than depth of object."     Part::partd: "Part specification xj[[1]] is longer than depth of object."          {{x[1], x[2], x[3]} -> {0.0985269, 0.990196, 0.995024}}


Possible bug in v9.0 Rest[] function

Just to be clear, this all works perfectly in v8.0.4.0. It only fails me in v9.0. I use 64-bit Linux, 64-bit versions of Mathematica, and I have 16GB of RAM. I have a data file formatted as follows:               Date,Open,High,Low,Close,Volume,OpenInt     19700102,1.6047,1.6140,1.6047,1.6140,881445,0     19700105,1.6140,1.6235,1.6047,1.6235,549208,0     19700106,1.6140,1.6140,1.6047,1.6140,508527,0     19700107,1.6140,1.6424,1.6140,1.6424,752620,0      There are 10839 rows of data in the file. I store the first col of data in a list called "dataDate", the second col of data in "dataOpen", etc... All works great until I try to print the data back to the screen. Version 8 displays the data as expected; but version 9 borks, the kernel resets, and all function definitions and data structures are reset. Here's the updated, simple code:               data = Import["pg.us.txt", "Data"];          (* Read the first row of data, to get the column headings *)     dataColumnHeadings = data[[1, All]]          (* Store each column of data in a separate list, removing the first element with Rest[] *)     dataDate = Rest[data[[All, 1]]];     dataOpen = Rest[data[[All, 2]]];     dataHigh = Rest[data[[All, 3]]];     dataLow = Rest[data[[All, 4]]];     dataClose = Rest[data[[All, 5]]];     dataVolume = Rest[data[[All, 6]]];     dataOpenInt = Rest[data[[All, 7]]];     Length[dataDate]     Length[dataOpen]     Length[dataHigh]     Length[dataLow]     Length[dataClose]     Length[dataVolume]     Length[dataOpenInt]      Now, if I try to display the contents of any of the seven lists, (by simply typing the list's name and evaluating it), it works perfectly in version 8. But in version 9, any attempt to evaluate a list by evaluation of its name causes Mathematica 9 to bork: all imported data is lost as all variables are undefined, user-defined functions cleared, etc. (blue text instead of black text). It takes about 6-7 seconds for the error to occur, after you evaluate the list name and it displays the truncated output. Here are links to my updated test notebook and data file if anyone would be kind enough to see if this is just a problem with my machine, or a bug: https://dl.dropbox.com/u/1224415/test_case.nb https://dl.dropbox.com/u/1224415/pg.us.txt Thanks UPDATE: As I stated in a response below, removing the "Rest[]" function, used to remove the first element of each list, seems to fix the problem. Perhaps I'll try to remove the first element in some other manner; or perhaps try to use "Rest[]" in a three step process (wasting RAM):               dataDate = data[[All, 1]];     dataDate2 = Rest[dataDate];     Clear[dataDate];      UPDATE 2: It doesn't matter how much I mess with the list data: as soon as I use the "Rest[]" command on it, and display the results to screen, the program borks. I'm calling this a bug and contacting Wolfram. This is what I get for being an early adopter...


Extracting frequencies with Fouriertransformation

I know this question came up so many times, but after browsing through many of the threads, I'm still not sure, if I'm doing it correctly with my dataset, so I'll give it a try. If have some sample data I know not much about. You can download it here ![enter image description here](http://i.stack.imgur.com/5kdBM.jpg) Now I want to look for possible dominant frequencies and it tried it like this:               ListLinePlot[Log[10, Abs[Fourier[data]]], PlotRange -> Automatic]      and I get this: ![enter image description here](http://i.stack.imgur.com/k4S8T.jpg) Correct me if I'm wrong, but I don't see any dominant frequencies in here. Do you guys come to the same conclusion? Honestly, I think I'm doing it all wrong because I'm really not sure which of the many functions of mathematica to use. EDIT: Now I'm totally confused. I just looked again in some of my books and what they did there was drawing the frequencies on the x-Axes and the Power on the y-Axes. Then they normalised it to the total power. How to do this?


Controlling the placement of the y-axis

I use `ListPlot` for showing the results of my numeric computation. ![enter image description here](http://i.stack.imgur.com/vMyfb.jpg) I make my own ticks, so I never know before hand where the vertical center of my plot will be. I want to put the y-axis in the center (because it's a center of symmetry in my task) of the plot by default. I know about `AxesOrigin`, but it doesn't take `Center` as a value. How can I put the y-axis in the center automatically without caring about ticks? ![enter image description here](http://i.stack.imgur.com/OOOeu.jpg)


How to find synchronization offset?

I have 2 sets of data containing delays (audio / video).               data1 = Table[Sin[x + RandomReal[]/4], {x, 0, 2 Pi, Pi/10}]     data2 = Table[Sin[x + Pi/4 + RandomReal[]/4], {x, 0, 2 Pi, Pi/10}]     ListLinePlot[{data1, data2}, PlotRange -> All, Filling -> {1 -> 0, 2 -> 0}]      ![enter image description here](http://i.stack.imgur.com/i4p4t.png) I want to correlate delays and find the synchronization offset.   * in one instance of time   * over a longer period


Improving Function with Loop Structure

I'd like to write a function that would perform a loop, I guess `Do` or `While` should be helpful here. I've simplified the problem, so that it is clear what I'd like to achieve. First, I have a simple function:               f[{x_, y_}] := {x + 1, y + 1};      Then I'd like to have another function to perform `Nest` operation on a given list.               f1[{a_, b_}] := Block[{c, d},      c = Sqrt[a];      d = Nest[f, {c, b}, 10];     ];      Now I'd like to develop `f1` in the following manner - if `d[[1]]` does not lie within a certain interval, let's say {49.5,50.5}, I'd like the function to perform `Nest` operation again, this time with starting value of `c=c+1` or `c=c-1` depending on whether `d[[1]]` was below or above the given interval. This should go on until `d[[1]]` lies within this interval, and the function should return list `{c,b}` with that value of `c` that enabled `d[[1]]` to lie within the interval. The algorithm is pretty simple, but since I'm not a programmer, it is quite difficult for me to execute in _Mathematica_. If anybody is interested, it's about counter current heat exchanger - I know the inlet temperature value, but I perform calculations backwards, `c=Sqrt[a]` is my initial guess on the temperature at the outlet. Thanks for any advice! **Update:** So far I developed something like this, which actually works:               f1[{a_, b_}] := Module[{c, d, abc},       c = Sqrt[a];       d = Nest[f, {N[c], b}, 10];       abc = Interval[{49.5, 50.5}];       While[Not[IntervalMemberQ[abc, d[[1]]]], If[d[[1]] < Min[abc], c = c + 1, c = c - 1];        d = Nest[f, {N[c], b}, 10]];       d     ];      I'm not sure if it's the best way to do that. Thanks for any comments.


Problems with Solve

I am having a problem similar to the previous question here. Solve either takes forever (I assume infinity) to run or returns an error. I have tried various combinations of using Round, Chop, N and Real to neaten up output, but I can't quite pinpoint where the problem is. In my previous question it was a mixture of exact and inexact coefficients causing Solve to run indefinitely, but here I am not sure. Normally I would post an analogous problem to make it easier for those reading but as I'm not sure even roughly where the issue is this time, I'm afraid I will post the full problem.               (*Nearest neighbour vectors*)     d1 = {0, -1} - {rx, ry};     d2 = {Sqrt[3]/2, 1/2} - {rx, ry};     d3 = {-Sqrt[3]/2, 1/2} - {rx, ry};          (*The coefficients*)     a = Norm[d1]^-3; b = Norm[d2]^-3; c = Norm[d3]^-3;          (*modulus of fq*)     modfq[k_] :=        Sqrt[a^2 + b^2 + c^2 + 2 a b Cos[k.(d1 - d2)] +          2 b c Cos[k.(d2 - d3)] + 2 a c Cos[k.(d1 - d3)]];          (*Differential of fq w.r.t x and y to find turning points and then find minimum*)     findMin[p_] := (rx = p[[1]]; ry = p[[2]];       Min[modfq /@ (Re[{x, y} /.             Solve[a b (d2 - d1)[[1]] Sin[{x, y}.(d1 - d2)] +                b c (d3 - d2)[[1]] Sin[{x, y}.(d2 - d3)] +                a c (d3 - d1)[[1]] Sin[{x, y}.(d1 - d3)] ==                a b (d2 - d1)[[2]] Sin[{x, y}.(d1 - d2)] +                b c (d3 - d2)[[2]] Sin[{x, y}.(d2 - d3)] +                a c (d3 - d1)[[2]] Sin[{x, y}.(d1 - d3)] == 0, {x, y}]])])          (*Array of positions*)     res = 2; (*<--Ultimately this will be a value of a few thousand*)     xArray = Range[-Sqrt[3]/2, Sqrt[3]/2, Sqrt[3]/res];     yArray = Range[3/4, -3/4, -3/(2 res)];     g[p_] := Transpose@{xArray, ConstantArray[p, Length[xArray]]};     rArray = g /@ yArray ;          (*Map findMin onto rArray*)     diagram = Map[findMin, rArray, {2}];     ArrayPlot[diagram, ColorFunction -> "Rainbow"]      In this form it runs indefinitely, and attempts at rounding, choping etc. just don't seem to be working for me. Any suggestions on what the problem is? Many thanks for any help, and apologies for the big code dump.


Why are functions called first-class objects in Mathematica?

I've heard lots of people say a function is a first-class object in _Mathematica_. "Everything is an expression, including function." "There is no distinction between functions and data." Having read the book _Power programming with Mathematica_ up to Chapter 5, I think I already have some basic knowledge about _Mathematica_ , but I'm still confused with this point. To be more specific, I think there is a critical difference between functions and data. When we treat `f` as a function, we would use `f[3]` ( **must use the brackets** ); whereas to have `f` treated as a usual expression, we would simply use `f`. So I think a function (such as `f[x_] := x^2`) and data/expression (such as `f := x^2` or `f = 123`) are totally different! A function can accept several arguments, but a normal expression can not! "There's no difference between functions and data", is it real? I also have another question (which has nothing to do with above). If we let symbol `f` have two characters "function" and "data(expression)" in the meantime, there will cause some problem. 1.               ClearAll[f]     f = 9     f[x_]:=x^2 (* message is printed *)      2.               ClearAll[f]     f[x_]:= x^2     f = 9   (* MMA considers it is legal here *)     ?f      ( *MMA shows the two definition of f above, but f is no longer                related to squaring something, as we can see below. *)     f[100]  (* this returns 9[100] *)     f       (* this returns 9 *)      Why is 2 OK, but not 1? In case 2, why does _Mathematica_ not erase the definition of "function" f when we define `f = 9`? Furthermore, why does _Mathematica_ allow the apparent error syntax `9[100]` without giving an error message? (We are very certain about numbers must not be a function name, the head of an normal expression!)


Find the best parallel lines to a given data set

I have a set of data in an uptrend. I would like to find two BEST parallel lines to contain all the data but I don't know how to approach it, anyone can help ? Thanks. ![find parallel lines](http://i.stack.imgur.com/wryu4.png)


Forcing an integral to be solved in separate terms

Using Mathematica I want to solve an integral over a function that contains both determined and undetermined parts which looks like this:               r[\[Theta], z] = Sqrt[(h/2)^2 - z^2] + g[\[Theta]] - h/2      As you can see the `h/2` and root terms are determined, but `g` remains an undetermined function of $\theta$. Now I take an integral over this function to both z and theta:               V = Integrate[[Integrate[1/2 r[\[Theta], z]^2, {z, -h/2, h/2}], {\[Theta], 0, 2 \[Pi]}]      which results in: $$V= \int_0^{2 \pi } \left(\frac{1}{8} (\pi -4) h^2 g(\theta )+\frac{1}{2} h g(\theta )^2+\frac{1}{48} (10-3 \pi ) h^3\right) \, d\theta$$ As you can see, the last term contains no dependence on $\theta$ and therefore I would like that part of the integral solved. In particular I would like my result to look like this $$V=\frac{1}{24} (10-3 \pi )\pi h^3 + \frac{1}{8} (\pi -4) h^2 \int_0^{2 \pi }g(\theta )\, d\theta+\frac{1}{2} h \int_0^{2 \pi }g(\theta )^2 \, d\theta$$ **Is there some way to force mathematica to solve the parts of the function that are not dependent (or with known dependence) on the variable towards which I integrate?**


How to override `?NumericQ`

I have a function `myFunc` which I is to be displayed cleanly if arguments are symbolic, but which can also be numerically evaluated. I do this by defining a complicated auxiliary function `pR` which is evaluated only if its arguments are numerical (probably not a good idea?).               kin[a_, b_, c_] = a^2 + b^2 + c^2 - 2 a b - 2 a c - 2 b c;     pR[s_?NumericQ, m0_?NumericQ, m1_?NumericQ] :=        1/s*Sqrt[kin[s, m0^2, m1^2]]*Log[(2 m0 m1)/(-s + m0^2 + m1^2 - Sqrt[kin[s, m0^2, m1^2]])]      The function (watered-down) I wish to define is               myFunc[n_?IntegerQ, s_, m0_, m1_] :=        Sum[         Binomial[n + 1, 2 idx3 + 1]*((s + m0^2 - m1^2)/(2 s))^(n - 2 idx3)           *(kin[s, m0^2, m1^2]/(4 s^2))^idx3, {idx3, 0, (n + 1)/2}] pR[s, m0, m1];      So for example:               myFunc[4,s,m,m]//Simplify     (*  ((m^4 - 3 m^2 s + s^2) pR[s, m, m])/s^2   *)      and the complicated mess is in `pR`. The problem I'm running into is:   1. I don't know how to code it so that the user can forcibly display the function `pR` in its entirety -- even if its arguments are symbolic, overriding the `?NumericQ`.   2. I would like to be able to take derivatives (`D`), `Limit`s, and perform a Taylor `Series` expansion on `myFunc` appropriately handling the auxiliary function `pR`. This should trigger the override in the previous point. Any ideas? Thanks!


Formatting Excel Borders with .Net

I have various tables generated in a _Mathematica_ application and need to export this to `MSExcel` formatted in a specific way. The `Excel` formatting has to be generated by _Mathematica_. I am not familiar with `.Net` (or `.NetLink`), but after searching, found this very useful code by Chris Degnan.               Needs["NETLink`"]     PutIntoExcel[data_List, cell_String, file_String] :=       Module[{rows, cols, excel, workbook, worksheet, srcRange},       {rows, cols} = Dimensions[data];       NetBlock[       InstallNET[];       excel = CreateCOMObject["Excel.Application"];       If[! NETObjectQ[excel], Return[$Failed],      excel[Visible] = True;      workbook = excel@Workbooks@Add[];      worksheet = workbook@Worksheets@Item[1];      srcRange = worksheet@Range[cell]@Resize[rows, cols];      srcRange@Value = data;      srcRange@Interior@Color = 13959039;      (* OLE colours from http://www.endprod.com/colors/ *)      worksheet@Range["E5:F5"]@Font@Bold = True;      worksheet@Range["E5:F5"]@Interior@Color = 61166;      worksheet@Range["E6:E9"]@Font@Color = 255;      (* Reset the numeric values to get the correct type *)      worksheet@Range["E6:E9"]@Value = Rest[data[[All, 1]]];      workbook@SaveAs[file];      workbook@Close[False];      excel@Quit[];      ]];      LoadNETType["System.GC"];      GC`Collect[]];          data = {{"Year", "Cartoon"}, {1928, "Mickey Mouse"}, {1934,         "Donald Duck"}, {1940, "Bugs Bunny"}, {1949, "Road Runner"}};     outputfile = "C:\\Temp\\demo.xlsx";     Quiet[DeleteFile[outputfile]];     PutIntoExcel[data, "E5", outputfile];          Print[Panel[TableForm[data, TableSpacing -> {2, 4}]]];      This explains in detail how to format colours, but I run into problems with borders. This code does work:               worksheet@Range["B3:C4"]@Borders@Color = 255;      However, specifying specific parts of the border does not:               worksheet@Range["B3:C4"]@Borders[xlDiagonalDown]@Color = 255;      and I get this error: > NET::nocomprop: No property named xlDiagonalDown exists for the given COM > object. Specifying the weight of the line like this:               worksheet@Range["B3:C4"]@Borders@Weight = xlThick;      gives a different error: > NET::methodargs: Improper arguments supplied for method named Weight. Can anyone suggest what may be wrong? Then after exporting a fancy formatted table to `Excel`, I need to export an `Excel` formula into the formatted cells, to enable the `Excel` user to modify and play with their own input data.


Plot3d: How to color a surface according to the slope of the surface?

Here is my approach, for an example surface function:               surface[x_, y_] := Sin[x y];      The normal vector of a point in the surface is computed as:               NormalVector[a_, b_] := {D[surface[xx, yy], xx], D[surface[xx, yy], yy],1} /. {xx -> a, yy -> b};      Then the plot is as follows:               Plot3D[surface[x, y], {x, 0, 3}, {y, 0, 3}, ColorFunction -> Function[{x, y, z},      RGBColor[0, 0, VectorAngle[NormalVector[x, y], {0, 0, 1}]]]]      However it fails, why?


At what point should MLSetMessageHandler() be called?

I have an `Install`able MathLink program written in C. I would like to use a custom message handler. At which point in the C source code should I call `MLSetMessageHandler()`? The standard structure for such an installable MathLink program is this:               int main(int argc, char* argv[]) {         return MLMain(argc, argv);     }      First I tried something like this:               /* does this look OK? */     void msghandler(MLINK link, int msg, int arg) {         switch (msg) {         case MLInterruptMessage:         case MLAbortMessage:             myabort();             break;         default:             stdhandler(link, msg, arg);         }     }          int main(int argc, char* argv[]) {         MLSetMessageHandler(stdlink, (MLMessageHandlerObject) msghandler); /* <- wrong place to set it */         return MLMain(argc, argv);     }      (I'm showing this code in full to also get some feedback on the structure of the message handler function.) This doesn't work for two reasons:   1. `MLSetMessageHandler()` fails and returns the code `MLEDEAD`, which I assume means that the link is not yet initialized. I suppose that's done in `MLMain()`.   2. `MLMain()` itself will call `MLSetMessageHandler()` and overwrite any previous one. **Question:** Is there a simpler way to fix this than writing my own `MLMain` replacement (`MLMain` is generated by `mprep`)?


Problem with extracting specific contour from a ContourPlot

I am trying to exctract contours of specific value (2.6*10^-6) out of a ContourPlot and measure their area. Below you can see the code. It is noticable that not all of the relevant contours showed in the left plot are shown on the right one as well. Any suggestion of what am I doing wrong?               data = Import["C:\\Users\\doa\\Documents\\private\\school\\PhD\\thesistex\\sigma_limit_difference.xlsx", {"Sheets", "synthetic clusters"}];     data = data[[2 ;; 3002, 2 ;; 3]];     \[ScriptCapitalD] = SmoothKernelDistribution[data, 9.34];     contour = ContourPlot[Evaluate@PDF[\[ScriptCapitalD], {x, y}], {x, 0, 1024}, {y, 0,      1024}, PlotRange -> {Automatic}, PlotPoints -> 50, Contours -> 10, ColorFunction -> "DarkRainbow", AxesStyle -> {30, 20}, ImageSize -> Scaled[0.7]];     contour2 =ContourPlot[Evaluate@PDF[\[ScriptCapitalD], {x, y}], {x, 0, 1024}, {y, 0,      1024}, PlotRange -> {Automatic}, PlotPoints -> 60, Contours -> {2.6*10^-6}, ColorFunction -> "DarkRainbow", AxesStyle -> {30, 20}, ImageSize -> Scaled[0.7],ContourLabels -> True];     {contour, contour2}      ![enter image description here](http://i.stack.imgur.com/MRKRG.jpg) I am not sure if there is a need to insert the excel file (in case it is needed please explain how and I will) thanks in advance Doron All thank you very much for the help:![enter image description here](http://i.stack.imgur.com/2eI0b.jpg) I tried again, this time using some random data so everyone can folow up. The solution of changing the PlotRange parameter to "All" did'nt solve the problem. It is not just the "White areas" are seen on the left plot with plotrange full, but most impoprtant is whay dont we see them all in the right Plot? Maybe it is related to very small contours? As for the contour area: Now I get an answer (Thanks...) but still get this warning message: > "NIntegrate::slwcon: Numerical integration converging too slowly; suspect > one of the following: singularity, value of the integration is 0, highly > oscillatory integrand, or WorkingPrecision too small. >>" here is the code I am using:               SeedRandom[5]; data = RandomReal[1024, {3000, 2}];     \[ScriptCapitalD] = SmoothKernelDistribution[data, 9.34];     contour = ContourPlot[Evaluate@PDF[\[ScriptCapitalD], {x, y}], {x, 0, 1024}, {y, 0,      1024}, PlotRange -> {All}, PlotPoints -> 50, Contours -> 10, ColorFunction -> "DarkRainbow", AxesStyle -> {30, 20}, ImageSize -> Scaled[0.4]];     contour2 =ContourPlot[Evaluate@PDF[\[ScriptCapitalD], {x, y}], {x, 0, 1024}, {y,0,1024}, PlotRange -> {All}, PlotPoints -> 60, Contours -> {2.52*10^-6}, ColorFunction -> "DarkRainbow", AxesStyle -> {30, 20}, ImageSize -> Scaled[0.4], ContourLabels -> True];     {contour, contour2}     GG = NIntegrate[Boole[PDF[\[ScriptCapitalD], {x, y}] > 11.52*10^-7], {x, 0, 1024}, {y, 0, 1024}]


Why don't these styling rules work when viewed in TableForm?

m = RandomInteger[{-5, 5}, {10, 10}];     m /. {x__, y_ /; y > 0} -> Style[{x, y}, Red]     % // TableForm      When `m` without style , `TableForm` or `Grid` works well on it. But when I set a style, it doesn't work as I expected. How can I fix the problem?


Recursion depth exceeded

Below is my code for numerical solving of PDE with Crank Nicolson scheme.                ClearAll[L, M, \[CapitalDelta]t, \[CapitalDelta]x]         L = Pi // N; M = 25;         \[CapitalDelta]x = L/M;         \[CapitalDelta]t = \[CapitalDelta]x^2; k = 1;         U0[x_] = x (Pi - x);         U[0, n_] := 0.;         U[M, n_] := 0.;         sol[0] = Table[U[j, 0] -> U0[j \[CapitalDelta]x], {j, 1, M - 1}];         sol[n_] :=           Module[{vars, eqns}, vars = Table[U[j, n], {j, 1, M - 1}];            eqns = Table[              U[j, n] - U[j, n - 1] ==                1/2 ((k \[CapitalDelta]t )/\[CapitalDelta]x^2 (U[j + 1, n] -                     2 U[j, n] + U[j - 1, n] + U[j + 1, n - 1] - 2 U[j, n - 1] +                     U[j - 1, n - 1])), {j, 1, M - 1}] /. sol[n - 1];           Solve[eqns, vars][[1]]          ]      The problem is, that I have to eveluate value of scheme for (Pi/4,2). That means i have to put 127 for n in code below. The problem is, that the program doesn't want to eveluate for such big numbers.               rez = Table[       Table[{\[CapitalDelta]x j, \[CapitalDelta]t n, U[j, n]}, {j, 0,           M}] /. sol[n], {n, 127}]      But if you go bigger for n, like 100, 400, and more it gives:               $RecursionLimit::reclim: Recursion depth of 256 exceeded. >>


Do "objects" in Mathematica have to be declared?

A while ago I learned a trick which allows one to imitate object-oriented programming in MMA using `SubValues`:               makeObj[identification_Integer] = Obj[identification];     makeObj[5]     (* Obj[5] *)      These can have "instance fields":               Obj[_]["field"] = 0 (* Default*);      And member functions:               Obj[id_Integer]["increase"] := (Obj[id]["field"]++;)     Obj[5]["increase"];     Obj[5]["field"]     (* 1 *)      However, in order to make an object, I have to identify it in `makeObj`, otherwise my `"field"` values will go to the default every time. Is there any implementation which allows me to create objects without explicitly naming the pointers to them? In other words, can I make the compiler internally assign pointers? In Java, something like:               java.util.ArrayList<myObj> a = new java.util.ArrayList<MyObj>();     for(int i = 0; i < 10; i++)         a.add(new myObj());     a.get(5).doStuff();      can be easily done, but how would I do it in Mathematica? (without `JLink`, of course) If this is not possible, is there some way to have garbage-handling? Like:               Obj["delete", id_] :=         DeleteCases[SubValues[Obj], HoldPattern[Obj[id][_]] :> _]      (Except this doesn't work)


Mollweide maps in Mathematica

**Context** In my field of research, many people use the following package: healpix (for Hierarchical Equal Area isoLatitude Pixelization) which has been ported to a few different languages (F90, C,C++, Octave, Python, IDL, MATLAB, Yorick, to name a few). It is used to operate on the sphere and its tangent space and implements amongst other things fast (possibly spinned) harmonic transform, equal area sampling, etc. In the long run, I feel it would be useful for our community to be able to have this functionality as well. As a starting point, I am interested in producing Mollweide maps in Mathematica. My purpose is to be able to do maps such as ![Mollweide projection of the Milky Way](http://i.stack.imgur.com/BygyL.png) which (for those interested) represents our Milky Way (in purple) on top of the the cosmic microwave background (in red, the afterglow of the Big Bang) seen by the Planck satellite. **Attempt** Thanks to halirutan's head start, this is what I have so far:               cart[{lambda_, phi_}] := With[{theta = fc[phi]}, {2 /Pi*lambda Cos[theta], Sin[theta]}]     fc[phi_] := Block[{theta}, If[Abs[phi] == Pi/2, phi, theta /.       FindRoot[2 theta + Sin[2 theta] == Pi Sin[phi], {theta, phi}]]];      which basically allows me to do plots like               grid = With[{delta = Pi/18/2},                 Table[{lambda, phi}, {phi, -Pi/2, Pi/2, delta}, {lambda, -Pi, Pi, delta}]];     gr1 = Graphics[{AbsoluteThickness[0.05], Line /@ grid, Line /@ Transpose[grid]},                    AspectRatio -> 1/2];     gr0 = Flatten[{gr1[[1, 2]][[Range[9]*4 - 1]],gr1[[1, 3]][[Range[18]*4 - 3]]}] //      Graphics[{AbsoluteThickness[0.2], #}] &;     gr2 = Table[{Hue[t/Pi], Point[{ t , t/2}]}, {t, -Pi, Pi, 1/100}] //      Flatten // Graphics;     gr = Show[{gr1, gr0, gr2}, Axes -> True]      ![initial image](http://i.stack.imgur.com/4ue2x.png)               gr /. Line[pts_] :> Line[cart /@ pts] /. Point[pts_] :> Point[cart[ pts]]      and project them to a Mollweide representation ![Mollweide projection of initial image](http://i.stack.imgur.com/SurTe.png) **Question** Starting from an image like this one: ![spherical Perlin noise, equirectangular projection](http://i.stack.imgur.com/4xyhd.png) (which some of you will recognize;-)) I would like to produce its Mollweide view. Note that `WorldPlot` has this projection. In the long run, I am wondering how to link (via MathLink?) to existing F90/C routines for fast harmonic transforms available in healpix.


WordBoundary issue in StringReplace

Why does the following `StringReplace` pattern match:               StringReplace["blah *hello* blah", ("*" ~~ ShortestMatch[str__] ~~ "*") :>          ("" <> str <> "")]     (* blah hello blah *)      but not when bracketing the pattern with `WordBoundary`:               StringReplace["blah *hello* blah", (WordBoundary ~~ "*" ~~          ShortestMatch[str__] ~~ "*" ~~ WordBoundary) :> ("" <> str <> "")]     (* "blah *hello* blah" *)


Legend of a plot: how to increase the size of the line/marker?

I'm using the following kind of code to do the legends of my plots:               PlotLegend -> {"Test1","Test2"}, LegendPosition -> {0.05,      0.2}, LegendBackground -> White, LegendBorder -> White, \     ShadowBackground -> White, LegendSize -> {0.75 ,      0.35}, LegendBorder -> None, LegendTextSpace -> 3      Which gives something like ![Example of legend for a plot](http://i.stack.imgur.com/1kthh.png) I would like to increase the size (width) of the line (color/type) of one item of the legend. I know it depends on the size of the whole box, but is it possible to control that independently ? **EDIT** The "package" of _Jens_ looks like the perfect solution for me. I used it to produce the following plot. In this case I use only one legend entry for both the data and the corresponding fit, but as he mentions in his answer they can be split. ![enter image description here](http://i.stack.imgur.com/9gptQ.png)


How to convert binary float to decimal float

I need to convert binary float to decimal float in Mathematica, ideally between any two bases. `FromDigits["1.111111", 2]` does not work.


Vectors in a spherical shell

I have written code that randomly generates a 3D vector of random magnitude. I now want to create a histogram of how many vectors lie in the concentric spherical shells (n*delta r, (n+1)delta r) starting from (0, delta r). The simplest way to do this is just find how many endpoints end up in each shell but I'm not sure how to go about this.


Animating transition between all graph representations obtained from curated data

Pappus graph is one of many graphs whose various data is contained within Mathematica. Mathematica typically keeps several ways of representing such graphs:               GraphData["PappusGraph", "AllImages"]      will give its several representations: ![enter image description here](http://i.stack.imgur.com/2INoM.gif) I found these images pretty amazing - they look very different! _How to create an animation that will gradually go through all representations of Papus graph?_ For example, to clarify the question, this is an animation made by Mark McClure created by transitioning from one to another "hardcoded" plot of the same graph: ![enter image description here](http://i.stack.imgur.com/D7mjJ.gif)               vc1 = # - {1, 1} & /@ {{0, 2}, {1, 2}, {2, 2}, {1, 1},        {0, 0}, {1, 0}, {2, 0}};     vc2 = {{1/2, -Sqrt[3]/2}, {-1/2, -Sqrt[3]/2}, {-1, 0},        {1/2, Sqrt[3]/2}, {1, 0}, {0, 0}, {-1/2, Sqrt[3]/2}};     vc[t_] := t*vc2 + (1 - t) vc1;     Animate[       Graph[{1, 2, 3, 4, 5, 6, 7},         UndirectedEdge@@@{{1, 2}, {2, 3}, {3, 7}, {7, 6}, {6, 5}, {5, 1},           {1, 6}, {4, 5}, {4, 7}},         PlotRange -> 1.1, VertexCoordinates -> vc[t]],       {t, 0, 1}, AnimationDirection -> ForwardBackward]      How to do it for any graph that is available in Mathematica currated data, for representatios given by `GraphData[<graph name>, "AllImages"]`? EDIT: This is part of the animation obtained with DyckGraph, using belisarius' solution: ![enter image description here](http://i.stack.imgur.com/lRqfp.gif) Also, BrouwerHaemersGraph: ![enter image description here](http://i.stack.imgur.com/fraOH.gif)


Operating one dialog from inside another

Nested Dialogs Experiment The InsideDialog works as expected when invoked from the command line. When started as a button action inside OuterDialog, it takes a very long time to start up (many seconds). When a button is selected, the Inside dialog never returns. Is there a clean way to make this happen without messing with undocumented system internals?               InsideDialog[] := Module[{ans},        ans = 0;        CreateDialog[{Button["  A  "  , DialogReturn[ans = "A"]],          Button["  B   "  , DialogReturn[ans = "B"]]}];        While[ans == 0, Pause[0.2]];        Return[ans];        ];          InsideDialog[]          (* Out[26]= A *)          lessonlist = {        "The Field Properties of \[DoubleStruckCapitalR] and \     \[DoubleStruckCapitalC]",        "Introduction to Vectors and Vector Spaces",        "Properties of Vector Arithmetic"};           OutsideDialog[] := Module[{ans2},        ans2 = 0;        CreateDialog[         Join[Button[#, DialogReturn[ans2 = InsideDialog[]], Method->"Queued"] & /@            lessonlist, {Button["Close", DialogReturn[ans2 = 1]]}]];        While[ans2 == 0, Pause[0.2]]; (* works OK if I do not wait here *)        Return[ans2];        ];           OutsideDialog[]          (* Out[29]= 1 *)


Set a path relative to $UserBaseDirectory in the option inspector

Is there a way to set a setting in the _option inspector_ to a path that is relative to some global Mathematica variable? I'm trying to set up a default stylesheet by setting `DefaultStyleDefinitions` to a style sheet located in `$UserBaseDirectory/SystemFiles/FrontEnd/StyleSheets`. I need the setting to be independent of the path to `$UserBaseDirectory` because I'm using the same settings on different machines where my user's directory has different names. But setting it to a value containing `$UserBaseDirectory` didn't work.


Drop row if sum of part of row is equal to zero

My problem is the following: Suppose I have a matrix A which looks the following:               A = {{1, 2, 0, 0, 0}, {2, 3, 0, 1, 0}, {3, 4, 1, 0, 0},          {5, 6, 0, 0, 1}, {6, 7, 0, 0, 0}}      What I want _Mathematica_ to do is to drop or delete an entire row if the sum of columns 3,4&5 of that specific row is equal to zero. E.g. `A[[1]]` should be dropped because the sum of the last three elements of this row is zero. Same for the last row of matrix `A`. I tried the following but it's not working, and I don't know whether it's my fault or whether _Mathematica_ got a problem with that specific case:               hallo2 = Do[       If[Transpose[hallo][[3]][[i]] + Transpose[hallo][[4]][[i]] +           Transpose[hallo][[5]][[i]] = 0, Drop[hallo[[n]]]], {i,         Length[Transpose[hallo][[1]]]}]      This is the error message I get: Set::write: Tag Plus in 0+0+1 is Protected. >> Set::write: Tag Plus in 0+0+1 is Protected. >> General::stop: Further output of Set::write will be suppressed during this calculation. >> value = 0;


What is the proper way to the pattern form Repeated in my code?

I'm matching a pattern with `Repeated (..)` How can I use the repeat count in the replacement rule? Example:                Cases[ { {0, 2, 2, 5, 2, 4, 1, 2}, {0, 1, 2, 3, 4, 5}} ,          {0, Repeated[x_ /; x != 5], 5, __} :> {0, Sequence @@ Table[x, {2}], 5}]                                                                          ^ <---?      > {{0, 2, 2, 5}} Obviously instead of hard coding the `2` I want the length of the repeat.. My workaround for this example is this:                #[[;; First@First@Position[#, 5]]] & /@          Cases[ { {0, 2, 2, 5, 2, 4, 1, 2}, {0, 5, 5, 1, 2, 3, 4, 5}} ,            {0, Repeated[x_ /; x != 5], 5, __} ]      > {{0, 2, 2, 5}} It seems there should be a cleaner solution though.


How to define a polynomial/function from an array of coefficients?

I have the coefficients of my desired polynomial in an array CoefArr (I'm new to mathematica, so I think of everything as arrays, it is actually a list I believe) starting with the constant at index 1. I want to turn this into a function I can evaluate like this:               f[x_] := CoefArr[[1]][[1]] + x*CoefArr[[2]][[1]] + etc.      So I can just do f[5] and get the answer. Is there a way to do this in general?


Network graph with lights not working

So I have               graph = Graph[{"Russia" \[DirectedEdge] "Crimea",         "Russia" \[DirectedEdge] "Donetsk",         "Russia" \[DirectedEdge] "Luhansk",         "Russia" \[DirectedEdge] "Kharkiv",         "Russia" \[DirectedEdge] "Sumy",         "Russia" \[DirectedEdge] "Chernihiv",         "Crimea" \[DirectedEdge] "Kherson",         "Donetsk" \[DirectedEdge] "Luhansk",         "Luhansk" \[DirectedEdge] "Donetsk",         "Luhansk" \[DirectedEdge] "Kharkiv",         "Kharkiv" \[DirectedEdge] "Luhansk",         "Kharkiv" \[DirectedEdge] "Sumy", "Sumy" \[DirectedEdge] "Kharkiv",         "Sumy" \[DirectedEdge] "Chernihiv",         "Chernihiv" \[DirectedEdge] "Sumy",         "Donetsk" \[DirectedEdge] "Kharkiv",         "Kharkiv" \[DirectedEdge] "Donetsk",         "Kherson" \[DirectedEdge] "Zaporizhzhya",         "Zaporizhzhya" \[DirectedEdge] "Kherson",         "Zaporizhzhya" \[DirectedEdge] "Donetsk",         "Donetsk" \[DirectedEdge] "Zaporizhzhya",         "Kherson" \[DirectedEdge] "Dnipropetrovsk",         "Dnipropetrovsk" \[DirectedEdge] "Kherson",         "Dnipropetrovsk" \[DirectedEdge] "Zaporizhzhya",         "Zaporizhzhya" \[DirectedEdge] "Dnipropetrovsk",         "Dnipropetrovsk" \[DirectedEdge] "Donetsk",         "Donetsk" \[DirectedEdge] "Dnipropetrovsk",         "Dnipropetrovsk" \[DirectedEdge] "Kharkiv",         "Kharkiv" \[DirectedEdge] "Dnipropetrovsk",         "Kherson" \[DirectedEdge] "Crimea",         "Dnipropetrovsk" \[DirectedEdge] "Poltava",         "Poltava" \[DirectedEdge] "Dnipropetrovsk",         "Poltava" \[DirectedEdge] "Kharkiv",         "Kharkiv" \[DirectedEdge] "Poltava",         "Poltava" \[DirectedEdge] "Sumy", "Sumy" \[DirectedEdge] "Poltava",         "Poltava" \[DirectedEdge] "Chernihiv",         "Chernihiv" \[DirectedEdge] "Poltava",         "Chernihiv" \[DirectedEdge] "Kiev",         "Kiev" \[DirectedEdge] "Chernihiv",         "Kiev" \[DirectedEdge] "Cherkassy",         "Cherkassy" \[DirectedEdge] "Kiev",         "Cherkassy" \[DirectedEdge] "Kirovohrad",         "Kirovohrad" \[DirectedEdge] "Cherkassy",         "Kiev" \[DirectedEdge] "Poltava", "Poltava" \[DirectedEdge] "Kiev",         "Poltava" \[DirectedEdge] "Cherkassy",         "Cherkassy" \[DirectedEdge] "Poltava",         "Kirovohrad" \[DirectedEdge] "Poltava",         "Poltava" \[DirectedEdge] "Kirovohrad",         "Kirovohrad" \[DirectedEdge] "Dnipropetrovsk",         "Dnipropetrovsk" \[DirectedEdge] "Kirovohrad",         "Kirovohrad" \[DirectedEdge] "Mykolayiv",         "Mykolayiv" \[DirectedEdge] "Kirovohrad",         "Mykolayiv" \[DirectedEdge] "Dnipropetrovsk",         "Dnipropetrovsk" \[DirectedEdge] "Mykolayiv",         "Mykolayiv" \[DirectedEdge] "Kherson",         "Kherson" \[DirectedEdge] "Mykolayiv",         "Mykolayiv" \[DirectedEdge] "Odessa",         "Odessa" \[DirectedEdge] "Mykolayiv",         "Odessa" \[DirectedEdge] "Kirovohrad",         "Kirovohrad" \[DirectedEdge] "Odessa",         "Odessa" \[DirectedEdge] "Vinnytsia",         "Vinnytsia" \[DirectedEdge] "Odessa",         "Vinnytsia" \[DirectedEdge] "Kirovohrad",         "Kirovohrad" \[DirectedEdge] "Vinnytsia",         "Vinnytsia" \[DirectedEdge] "Cherkassy",         "Cherkassy" \[DirectedEdge] "Vinnytsia",         "Vinnytsia" \[DirectedEdge] "Kiev",         "Kiev" \[DirectedEdge] "Vinnytsia",         "Vinnytsia" \[DirectedEdge] "Zhytomyr",         "Zhytomyr" \[DirectedEdge] "Vinnytsia",         "Zhytomyr" \[DirectedEdge] "Kiev",         "Kiev" \[DirectedEdge] "Zhytomyr",         "Vinnytsia" \[DirectedEdge] "Khmelnytsky",         "Khmelnytsky" \[DirectedEdge] "Vinnytsia",         "Khmelnytsky" \[DirectedEdge] "Zhytomyr",         "Zhytomyr" \[DirectedEdge] "Khmelnytsky",         "Khmelnytsky" \[DirectedEdge] "Rivne",         "Rivne" \[DirectedEdge] "Khmelnytsky",         "Rivne" \[DirectedEdge] "Zhytomyr",         "Zhytomyr" \[DirectedEdge] "Rivne",         "Vinnytsia" \[DirectedEdge] "Chernivtsi",         "Chernivtsi" \[DirectedEdge] "Vinnytsia",         "Chernivtsi" \[DirectedEdge] "Khmelnytsky",         "Khmelnytsky" \[DirectedEdge] "Chernivtsi",         "Chernivtsi" \[DirectedEdge] "Ternopil",         "Ternopil" \[DirectedEdge] "Chernivtsi",         "Ternopil" \[DirectedEdge] "Khmelnytsky",         "Khmelnytsky" \[DirectedEdge] "Ternopil",         "Ternopil" \[DirectedEdge] "Rivne",         "Rivne" \[DirectedEdge] "Ternopil",         "Rivne" \[DirectedEdge] "Lutsk", "Lutsk" \[DirectedEdge] "Rivne",         "Lutsk" \[DirectedEdge] "Lviv", "Lviv" \[DirectedEdge] "Lutsk",         "Lviv" \[DirectedEdge] "Ternopil",         "Ternopil" \[DirectedEdge] "Lviv",         "Lviv" \[DirectedEdge] "Ivano-Frankivsk",         "Ivano-Frankivsk" \[DirectedEdge] "Lviv",         "Ivano-Frankivsk" \[DirectedEdge] "Ternopil",         "Ternopil" \[DirectedEdge] "Ivano-Frankivsk",         "Ivano-Frankivsk" \[DirectedEdge] "Chernivtsi",         "Chernivtsi" \[DirectedEdge] "Ivano-Frankivsk",         "Ivano-Frankivsk" \[DirectedEdge] "Uzhgorod",         "Uzhgorod" \[DirectedEdge] "Ivano-Frankivsk",         "Uzhgorod" \[DirectedEdge] "Lviv",         "Lviv" \[DirectedEdge] "Uzhgorod"}, VertexLabels -> "Name",        ImagePadding -> 10]      Which produces a graph. Then,               trans = Transpose[Normal[AdjacencyMatrix[graph]]];          Total[Normal[AdjacencyMatrix[graph]]];          Position[Total[Normal[AdjacencyMatrix[graph]]], 0] // Flatten;          input = Table[0, {l, 1, 27}]; (input[[#]] = 1) & /@    Position[Total[Normal[AdjacencyMatrix[graph]]], 0] // Flatten; input      Which gives               {1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}      Then               grr = Graphics[{Red, PointSize[0.05], Point[{0, 0}]}]; grg = Graphics[{Green, PointSize[0.05], Point[{0, 0}]}];          AdjacencyGraph[Transpose[trans], ImageSize -> Medium,   VertexStyle -> Table[i -> If[input[[i]] == 1, Red, Green], {i, 1, 27}]]      Which doesn't give me the graph I want, which should be of Russia with a red light and the rest with green. I just get some more code: > AdjacencyGraph[Automatic, {{0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, > 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, > 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, > 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, > 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 1, 1, 0, 1, 0, 0, 0, 1, 1, 0, > 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, > 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 1, 0, 0, 0, 0, > 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 1, 0, 0, 0, 0, 0, 0, 1, > 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 1, 0, 0, 0, 0, 1, > 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 1, 0, 1, 0, 0, > 1, 1, 0, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 1, 1, > 1, 0, 0, 1, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, > 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, > 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, > 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, > 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, > 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0}, > {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 1, 0, 1, 1, 0, 1, 0, 0, 0, 0, > 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, > 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 1, 1, 0, > 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, > 1, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, > 1, 0, 0, 1, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, > 1, 0, 0, 1, 1, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, > 1, 0, 0, 0, 1, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, > 0, 0, 0, 1, 1, 0, 1, 1}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, > 0, 0, 0, 1, 1, 0, 1, 0, 1}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, > 0, 0, 0, 0, 0, 0, 0, 1, 1, 0}}, ImageSize -> Medium,   >  VertexStyle -> {1 -> RGBColor[1, 0, 0], 2 -> RGBColor[0, 1, 0], 3 -> > RGBColor[0, 1, 0], 4 -> RGBColor[0, 1, 0], 5 -> RGBColor[0, 1, 0], 6 -> > RGBColor[0, 1, 0], 7 -> RGBColor[0, 1, 0], 8 -> RGBColor[0, 1, 0], 9 -> > RGBColor[0, 1, 0], 10 -> RGBColor[0, 1, 0], 11 -> RGBColor[0, 1, 0], 12 -> > RGBColor[0, 1, 0], 13 -> RGBColor[0, 1, 0], 14 -> RGBColor[0, 1, 0], 15 -> > RGBColor[0, 1, 0], 16 -> RGBColor[0, 1, 0], 17 -> RGBColor[0, 1, 0], 18 -> > RGBColor[0, 1, 0], 19 -> RGBColor[0, 1, 0], 20 -> RGBColor[0, 1, 0], 21 -> > RGBColor[0, 1, 0], 22 -> RGBColor[0, 1, 0], 23 -> RGBColor[0, 1, 0], 24 -> > RGBColor[0, 1, 0], 25 -> RGBColor[0, 1, 0], 26 -> RGBColor[0, 1, 0], 27 -> > RGBColor[0, 1, 0]}]


Sum similar elements

I am interested in summing elements in a list or sublist that are similar. I want the sublists of my second elements to be added cumulatively only if their first elements are the same. This is my list: `{{3, 1}, {5, 1}, {5, 2}, {3, 3}}`. This is my desired result: `{{1,1},{1,3},{4,3}}`.


Putting a matrix inside function

I want to fit a function to some data and inside the function there's a list here's my data               Ei = {{1, -0.00006636511699298353`}, {2, -0.00007582534298933297`}, \     {3, -0.00008658039298836684`}, {4, -0.00009882137899808185`}, {5, \     -0.0001127647090015671`}, {6, -0.00012865092799074773`}, {7, \     -0.00014674610198994742`}, {8, -0.00016733831999715676`}};      the list               racc = {6.0, 5.9, 5.8, 5.7, 5.6, 5.5, 5.4, 5.3, 5.2, 5.1};      and my function               U[r_] := ecc (1 - (racc[[r]] - Exp[-Acc (1 - rscc)])^2);      But mathematica shows my function as               ecc (1 - (-E^(-Acc (1 - rscc)) + {6., 5.9, 5.8, 5.7, 5.6, 5.5, 5.4,         5.3, 5.2, 5.1}[[r]])^2)      Though in someway it can understand it and give the result for function               U[3] /. {ehh -> 1, Ahh -> 1, rshh -> 1, ech -> 1, Achrsch -> 1,      ecc -> 1, Acc -> 1, rscc -> 1};          -22.04      And it's able to fit it, although an giving an error               sol = FindFit[Ei, U[r], {ecc, Acc, rscc}, r]          Part::pspec: Part specification r is neither an integer nor a list of integers. >>         {ecc -> 3.45136*10^-6, Acc -> -21.5489, rscc -> 2.67028}      It can not Plot it               P2 = Plot[U[r] /. sol, {r, 1, 8}];     Part::pspec: Part specification 1.000143` is neither an integer nor a list of integers. >>     Part::pspec: Part specification 1.1430001428571428` is neither an integer nor a list of integers. >>     Part::pspec: Part specification 1.2858572857142856` is neither an integer nor a list of integers. >>     General::stop: Further output of Part::pspec will be suppressed during this calculation. >>      Does anybody have an idea how to put a matrix or list inside a function?


Getting messages Rest::norest and Divide::indet from ContourPlot3D

**Note:** The bug described in this post is found in Mathematica version 9 and seems to have been fixed in version 10. Ok I don't know if it's a bug or what, but here's what I found: If I use this function:               ContourPlot3D[Cos[2*Pi*z] + Cos[2*Pi*y] + Cos[2*Pi*x], {x, 0, 1}, {y, 0, 1}, {z, 0, 1}]      I get this error: > Rest::norest: Cannot take the rest of expression {} with length zero. >> I have found that this issue is sometimes due to a need to use a numeric function. So I used:               ContourPlot3D[N[Cos[2*Pi*z] + Cos[2*Pi*y] + Cos[2*Pi*x]], {x, 0, 1}, {y, 0, 1}, {z, 0, 1}]      And I get this error: > Divide::indet: Indeterminate expression 0./0. encountered. >> Range::range: > Range specification in Range[3.,3.,0.] does not have appropriate bounds. >> I also tried:               ContourPlot3D[Cos[2*Pi*z?NumericQ] + Cos[2*Pi*y?NumericQ] + Cos[2*Pi*x?NumericQ],        {x, 0, 1}, {y, 0, 1}, {z, 0, 1}]      But I get: > ContourPlot3D::valuef: N[Cos[2 π z?NumericQ]+Cos[2 π y?NumericQ]+Cos[2 π > x?NumericQ]] must be a numerical function. >> However, if I try any of this:               ContourPlot3D[N[Cos[z] + Cos[y] + Cos[x]], {x, 0, 2*Pi}, {y, 0, 2*Pi}, {z, 0,2*Pi}]     ContourPlot3D[Cos[z] + Cos[y] + Cos[x], {x, 0, 2*Pi}, {y, 0, 2*Pi}, {z, 0, 2*Pi}]      I get no error what-so-ever. But the error with `NumericQ` persists. I'd also like to point out that the `NumericQ` error is the only one preventing me from getting the 3D graphics. Does anybody know what's going on?


Mysterious behavior of Precision for complex arrays

Mysterious behavior of `Precision`:               {{1.0+I*0.0},{0.0+I*0.0}} // SetPrecision[#,30]& // Precision // Print;      > >     0. >                 {{1.0},{0.0}} // SetPrecision[#,30]& // Precision // Print;      > >     30. >   Why is the precision zero in the first instance, but not the second? This led to some tough-to-diagnose program behaviors!


Equivalent of MATLAB's "hold on" function

I'm making an animation where the number of iterations is known. I tried using `Dynamic`, as I prefer updating in real time over generating data before plotting. I want it to look like the following, but _Mathematica_ seems to lack a built-in function like MATLAB's `hold on`, which keeps the current plot when adding new content (lines, points) instead of erasing it first. Is there a pretty way to do this？               Clear["`*"];     forward[{x1_, y1_}, {x2_, y2_}, v_: 5] :=       Block[{alpha},        alpha = Switch[Sign[x1 - x2],          -1, ArcTan[(y2 - y1)/(x2 - x1)],          1, Pi + ArcTan[(y2 - y1)/(x2 - x1)],          0, Pi/2,          _, -Pi/2];        {x1 + v 0.01 Cos[alpha], y1 + v 0.01 Sin[alpha]}        ];          Module[{plt, p1, p2, p3, p4},      {p1, p2, p3, p4} = {{-3, 0}, {0, 3}, {3, 0}, {0, -3}};      Print@Dynamic@plt;      While[! Or @@Thread[Norm[# - #2] & @@@ Subsets[{p1, p2, p3, p4}, {2}] < .01],       p1 = forward[p1, p2];       p2 = forward[p2, p3];       p3 = forward[p3, p4];       p4 = forward[p4, p1];       plt = ListPlot[List /@ {p1, p2, p3, p4},          PlotRange -> {{-4, 4}, {-4, 4}}, AspectRatio -> Automatic,          PlotStyle -> {Red, Green, Blue, Orange}];       Pause[.05]       ];      ]      ![enter image description here](http://i.stack.imgur.com/EaYQt.gif)


Drawing Cylindrical Segment with Graphics3D

For a visualization I need a combination of 3 Cylindrical segments to visualize the incident, reflected and refracted beam of light at a surface. I got as far as the following code.               Graphics3D[{       Polygon[{{-1.5, -1.5, 0}, {1.5, -1.5, 0}, {1.5, 1.5,0}, {-1.5, 1.5, 0}}],        Polygon[{{-1.5, 0, -1.5}, {1.5, 0, -1.5}, {1.5, 0, 1.5}, {-1.5, 0,1.5}}],       Opacity[0.5],        Cylinder[{{-1, 1, 0}, {0.2, -0.2, 0}}, 0.2],        Cylinder[{{-0.2, -0.2, 0}, {1, 1, 0}}, 0.2],        Scale[Cylinder[{{-0.05, 0.125, 0}, {0.5, -1, 0}}, 0.25], {1, 1,0.8}]     }]      results in the following output ![Mathematica Screenshot](http://i.stack.imgur.com/BBOkd.png) Obviously, the remaining "stumps" of the cylinder segments on the respective other side of the reflection plane need to be removed. I do not want to go to too complex approaches like using Parametric surfaces or similar mathematical descriptions of a cylindrical segment, mainly for performance reasons (all of these methods are getting rather slow to plot). There is an interesting method documented in MathWorld, but the link to the `ExtraPackages`Hidekazu`Knife`` package is broken, and the more recent link ends in 2007 too (checked through Wayback). Maybe there are much simpler hacks to remove the unwanted cylinder areas?


Generating list of coordinates in $\mathbb{Z}^n$ given by set of inequalities

I am trying to generate list of coordinates that forms a subset in the integer lattice $\mathbb{Z}^n$. This set is given by set of inequalities. Right now, I am using the following:               n=2;     k=100;     baseLattice = Tuples[Range[0, k], {n}];     coords = DeleteCases[DeleteCases[baseGrid,          x_ /; x[[2]] > (1.9*x[[1]] + 3)],         x_ /; x[[2]] < (1.9*x[[1]] - 4)];      This approach has the obvious disadvantage that for larger n or k the Tuples command generates all points in the first quadrant. I realize could also build my set in some loop, however I feel like there could be a straightforward solution which I have not yet figured out. For illustration, I am trying to get a set of coordinates similar to the set of red dots in this picture: ![Example of set of points given by two lines of same slope](http://i.stack.imgur.com/zAKYm.jpg) `Edit:`   I did not post my original problem in full in the OP. For the slopes of the lines, I am using numerical values of algebraic numbers. I used the following code to compare performance of suggested brute-force solutions: Solve by Daniel Lichtblau:               f = #^2 - # - 1 &;     q = AlgebraicNumber[Root[f, 2], {0, 1}];     q = N[q];     coords1 = {x, y} /.        Solve[{0 <= x <= y - 1, 0 <= y <= 100, q*x - q^2 <= y <= q* x + 2*q}, {x, y}, Integers]      And vectorization by Szabolcz:               lattice = Tuples[Range[0, 100], 2];     {x, y} = Transpose[lattice];     coords2 =         Pick[lattice, UnitStep[q*x + 2*q - y] UnitStep[y - (q*x - 2 q^2)], 1];      I run the code with k = 100 and n = 2. For q = N[algebraic number]:   Solve ... 50.11s   Vectorization ... 0.02s   My original way ... 0.17s. Turns out this is somewhat unfair to solve, as when I take q = algebraic number itself (I guess not surprisingly):   Solve ... 50.28s   Vectorization ... 81.43s   My original way ... 78.91s.


Domain errors with Maximize/NMaximize

I am trying to maximize a (somewhat) complicated function over probability distribution $p$ and $q$. Here is my input:               Maximize[{(p0 q2 + p2 q0)^0.5 + (p0 q1 + p1 q0)^0.5 + (p1 q3 + p3 q1)^0.5                 + (p2 q3 + p3 q2)^0.5,                (0 <= p0 <= 1) && (0 <= p1 <= 1) && (0 <= p2 <= 1) && (0 <= p3 <= 1) &&                (0 <= q0 <= 1) && (0 <= q1 <= 1) && (0 <= q2 <= 1) && (0 <= q3 <= 1) &&               (p0 + p1 + p2 + p3 == 1) && (q0 + q1 + q2 + q3 == 1)},                {p0, p1, p2, p3, q0, q1, q2, q3}] // N       However, I get this error: > >     NMaximize::nrnum: "The function value -0.862277-0.353837 I is not a real > number at >     { p0, p1, p2, p3, q0, q1, q2, q3} = { -0.00823803, 0.168927, 0.643765, > 0.195547, >                                           -0.0740624, 0.571036, 0.228872, > 0.274154  }." >   I find this odd, since I thought the constraints should disallow that.   Oddly enough, `FindMaximum` works fine.


A problem with Deploy and Locator in a Manipulate

I recently asked a question about Locators not behaving properly (see Locators and Table within a Manipulate are not behaving) and thought I had figured out the answer. However, as I played around to figure out why the problem existed in the first place I discovered that using Deploy caused the problem to return. Here is as simple of an example as I can come up with that reproduces the problem and maintains some of the features that I need in the Manipulate. Particularly, I need to link the two sliders with the Locator. The following works fine:               Manipulate[      vector = Graphics[{Green, Arrow[{{0, 0}, p}],          Locator[Dynamic[p, (p = #; x = p[[1]]; y = p[[2]]) &]]}];       Show[{vector}, PlotRange -> {{-2.1, 2.1}, {-2.1, 2.1}},        ImageSize -> 500],       Row[{"Ax", Manipulator[Dynamic[x, (x = #; p[[1]] = x) &], {-2, 2}],         Spacer[4], Dynamic[x]}],       Row[{"Ay", Manipulator[Dynamic[y, (y = #; p[[2]] = y) &], {-2, 2}],         Spacer[4], Dynamic[y]}],      {{p, {1, 1}}, None},      {{x, 1}, None},      {{y, 1}, None},      TrackedSymbols -> {x, y, p}]      ![Mathematica graphics](http://i.stack.imgur.com/y1ugF.png) You get a green arrow that you can move with either the Locator or the Sliders (one component at a time). However, if the user clicks slightly off of the Locator they highlight the whole graphics image and go into an editing mode. Users unfamiliar with this may not know what to do so I want to prevent this by using Deploy. Adding Deployed->True as an option to the Manipulate doesn't work. The documentation for Manipulate says that it should, but for some reason it does nothing here. So instead I wrapped Deploy around Show:                Deploy@Show[{vector}, PlotRange -> {{-2.1, 2.1}, {-2.1, 2.1}},        ImageSize -> 500],      Now the user doesn't accidentally go into editing mode, but the Locator doesn't work. The Sliders do move the vector around and the Locator moves with them, but I can't move the locator with the mouse except for a VERY small distance at a time. I'm wondering if this might have something to do with how I have linked the various control variables using the second argument of Dynamic. Perhaps the solution to this is also ultimately the solution to the question I referenced above. Thanks!


Numerically solving Helmholtz equation in 2D for arbitrary shapes

I would like to solve the Helmholtz equation with dirichlet boundary conditions in 2 dimensions for an arbitrary shape. (for a qualitative comparison of the eigenstates to periodic orbits in the corresponding billiard systems): $\Omega =$ some boundary e.g. a circle, a regular polygon etc. $ \triangledown^2 u(x,y) + k^2u(x,y) =0 \quad x,y \in \Omega \\ u(x,y) = 0 \quad x,y \in \partial\Omega $ There seems already to be a solution here, unforuntalty I'm not experienced enough with Mathematica to extract a minimal working example from this code and adapt it to my needs. **Is there a way to use NDSolve (or ParametricNDSolve) to calculate the eigenvalues k and corresponding eigenstates for the problem?** As far as I understand Mathematica can handle FEM and finite difference methods, which could be used to solve this kind of equations?


How to create a user interface, that when a user clicks a button the entire display changes?

For example, the 'main menu' user interface has three buttons each labeled with a different level. Whenever button is clicked how do you display that level of the game without creating a new notebook?


Need help defining my own rounding function

First of all: I'm a beginner with _Mathematica_.   1. I'd like to define a function called `Rounding` which does the following:     * if for $x = n+a, n \in \mathbb{N}, a\in [0,1)$ I have $a < 0.5$ then the function should round down to $n$. Otherwise it should round up to $n+1$. I did this:               Rounding[x_] := If[x - Floor[x] < 0.5, Floor[x], Ceiling[x]]      It works.   2. I'd like to create a list `LIST` of random integers and THEN create a `LIST2` which rounds the elements of LIST with my Rounding function.              LIST = Table[RandomInteger[{-10,10}]/2, {i,1,10}]          LIST2 = Table[Round[...]???      I tried choosing each element of `LIST` by using `Part[LIST,{k,1,10}]` but I don't get it.


How do I get Mathematica to return a function call unevaluated?

How do I get _Mathematica_ to return a function call (conditionally) unevaluated? I expect this may use the slightly-mysterious `Hold` function. As a toy example, suppose I want to define `AlgebraicQ` such that `AlgebraicQ[x]` returns `True` or `False` when `Element[x, Algebraics]` evaluates to `True` or `False`, but otherwise to returns `AlgebraicQ[x]`, just like the other predicate functions do. (I can't just ask if `Element[x, Algebraics] == True`, because this is itself unevaluated.) Edit: The first thing that came to mind didn't work, as you can see: ![With the definition AlgebraicQ\(a_\) := Element\(a, Algebraics\), the function AlgebraicQ\[Pi+E\] returns Element\(E+Pi, Algebraics\) instead of the desired AlgebraicQ\(Pi+E\). Parens used in place of brackets because of platform limitations.](http://i.stack.imgur.com/j5VO2.png) I had tried this before posting, but on a recommendation I tried again with a fresh kernel (pictured above) with the same results. I also tried               AlgebraicQ[a_] := True /; Element[x, Algebraics]     AlgebraicQ[a_] := False /; ! Element[x, Algebraics]      based on an earlier suggestion but this seems not to work at all. * * * # Final working solution based on Szabolcs' answer:               AlgebraicQ[a_] := With[{result = Element[a, Algebraics]},       result /; MatchQ[result, True | False]]      which tests as expected: > AlgebraicQ /@ {7, Pi, Pi + E} > > Out[2]= {True, False, AlgebraicQ[E + Pi]}


Proper use of arbitrary number of variables

So, I'm working on a project where the number of independent variables is not fixed. Consider a problem of $N$ independent variables, $\boldsymbol{r}$. I want to perform different things with them. Amongst them, I want to consider (multidimensional) integration, etc. ## Variables definition My first question regarding this topic, is the definition of the variables to perform algebraic manipulation. My first though was to use               variables[N_]:=Table[x[i],{i,1,N}]      However, in some situations, (e.g. with Block), I cannot use these variables as I use x1,x2,.... e.g.               Block[{x[1]=2},x[1]^2]      gives an error. (my current naive solution is to use):               variables[N_] := Table[ToExpression["x" <> ToString[i]], {i, 1, N}];      Is there any more standard solution? ### Sums, integrals This question also holds for the problem of computing integrals for arbitrary dimensions. How can I tell _Mathematica_ to compute               Integrate[f[{r1,r2,...,rn}], {r1, 0, 1}, {r2, 0, g[r1]},...,{rN, 0, h[{r1,r2,...,"rN-1"}]}]      Most of the times I will be interested in numerically compute the integral, but nevertheless, how do I tell _Mathematica_? I tried the simple "naive"               Integrate[1, Table[{i, 0, 1}, {i, variables[3]}]]      but it gives an error.


Multi-Fitting with Nonlinear model

I want to fit experimental data by the H-N model. Here is the H-N model: $$\text{EHN}(T)\text{=}\text{E$\infty $}+\frac{\text{E0}-\text{E$\infty $}}{\left(1+\left(i \omega\tau(T_g)10^{-\frac{\text{C1} (T-\text{Tg})}{\text{C2}+(T-\text{Tg})}}\right)^{\alpha }\right)^{\beta }}$$ Here is my data and code.                  dataRe={{135., 2286.88}, {136., 1889.46}, {137., 1567.42}, {138.,                1294.73}, {139., 1081.55}, {140., 902.773}, {141., 761.623}, {142.,                643.534}, {143., 550.366}, {144., 470.925}, {145., 405.269}, {146.,                348.847}, {147., 303.248}, {148., 263.789}, {149., 230.926}, {150.,                202.368}, {151., 178.676}, {152., 158.557}, {153., 142.725}, {154.,                129.218}, {155., 118.192}, {156., 108.735}, {157., 101.272}, {158.,                94.8359}, {159., 89.3741}, {160., 84.4597}, {161., 80.1335}, {162.,                76.1632}, {163., 72.6128}, {164., 69.2969}, {165., 66.227}, {166.,                63.3502}, {167., 60.7664}, {168., 58.3432}, {169., 56.0645}, {170.,                53.8886}, {171., 51.8571}, {172., 49.9009}, {173., 48.014}, {174.,                46.1953}, {175., 44.4969}, {176., 42.8668}, {177., 41.3076}, {178.,                39.7966}, {179., 38.3511}, {180., 36.9621}, {181., 35.6673}, {182.,                34.4443}, {183., 33.3239}, {184., 32.2584}, {185., 31.245}, {186.,                30.2813}, {187., 29.4031}, {188., 28.5708}, {189., 27.781}, {190.,                27.0241}, {191., 26.3191}, {192., 25.6392}, {193., 24.975}, {194.,                24.3329}, {195., 23.7381}, {196., 23.1738}, {197., 22.6451}, {198.,                22.1308}, {199., 21.6239}, {200., 21.1439}, {201., 20.7245}, {202.,                20.3002}, {203., 19.8216}, {204., 19.3485}, {205., 18.9218}, {206.,                18.5166}, {207., 18.1276}, {208., 17.7492}, {209., 17.3845}, {210.,                17.0318}, {211., 16.6938}, {212., 16.3641}, {213., 16.0424}, {214.,                15.7233}, {215., 15.4063}, {216., 15.0967}, {217., 14.8008}, {218.,                14.5269}, {219., 14.2817}, {220., 14.0376}, {221., 13.7849}, {222.,                13.5334}, {223., 13.288}, {224., 13.0538}, {225., 12.831}, {226.,                12.6145}, {227., 12.4025}, {228., 12.1932}, {229., 11.9889}, {230.,                11.8003}, {231., 11.622}, {232., 11.442}, {233., 11.2606}, {234.,                11.0808}, {235., 10.9046}, {236., 10.7371}, {237., 10.577}, {238.,                10.4275}, {239., 10.2802}, {240., 10.1313}, {241., 9.98528}, {242.,                9.84445}, {243., 9.70511}, {244., 9.56583}, {245., 9.42439}, {246.,                9.28424}, {247., 9.16163}, {248., 9.05307}, {249., 8.94078}, {250.,                8.82361}, {251., 8.70563}, {252., 8.58908}, {253., 8.47813}, {254.,                8.37066}, {255., 8.26599}, {256., 8.16324}, {257., 8.06268}, {258.,                7.9627}, {259., 7.86389}, {260., 7.77106}, {261., 7.68272}, {262.,                7.59522}, {263., 7.50776}, {264., 7.4199}, {265., 7.33254}, {266.,                7.24746}, {267., 7.16453}, {268., 7.0849}, {269., 7.00582}, {270.,                6.92552}, {271., 6.84306}, {272., 6.76014}, {273., 6.68684}, {274.,                6.62505}, {275., 6.56069}, {276., 6.4861}, {277., 6.4139}, {278.,                6.34826}, {279., 6.28453}, {280., 6.2223}, {281., 6.16394}, {282.,                6.10795}, {283., 6.04993}, {284., 5.99424}, {285., 5.94735}, {286.,                5.90123}, {287., 5.84622}, {288., 5.78872}, {289., 5.74026}, {290.,                5.69521}, {291., 5.65082}, {292., 5.60682}, {293., 5.56378}, {294.,                5.52176}, {295., 5.48153}, {296., 5.44198}, {297., 5.40113}, {298.,                5.36029}, {299., 5.32389}, {300., 5.29061}, {301., 5.25599}, {302.,                5.22026}, {303., 5.18636}, {304., 5.15429}, {305., 5.12238}, {306.,                5.09002}, {307., 5.05626}, {308., 5.0215}, {309., 4.9884}, {310.,                4.95724}, {311., 4.9259}, {312., 4.89414}, {313., 4.86346}, {314.,                4.83431}, {315., 4.80636}, {316., 4.77938}, {317., 4.75121}, {318.,                4.72102}, {319., 4.69132}, {320., 4.66365}, {321., 4.63793}, {322.,                4.61535}, {323., 4.5939}, {324., 4.57255}, {325., 4.55129}, {326.,                4.53031}, {327., 4.50947}, {328., 4.48862}, {329., 4.46747}, {330.,                4.44536}, {331., 4.42347}, {332., 4.40477}, {333., 4.3878}, {334.,                4.36821}};         dataIm={{135., 887.339}, {136., 797.248}, {137., 701.968}, {138.,            608.569}, {139., 523.492}, {140., 445.966}, {141., 379.817}, {142.,            322.098}, {143., 274.838}, {144., 234.408}, {145., 201.682}, {146.,            173.669}, {147., 150.826}, {148., 130.956}, {149., 114.338}, {150.,            99.8744}, {151., 87.8489}, {152., 77.4709}, {153., 69.0043}, {154.,            61.7297}, {155., 55.8849}, {156., 50.8427}, {157., 46.6994}, {158.,            43.0493}, {159., 39.9282}, {160., 37.1165}, {161., 34.6505}, {162.,            32.3913}, {163., 30.3725}, {164., 28.5008}, {165., 26.8072}, {166.,            25.2321}, {167., 23.8052}, {168., 22.4737}, {169., 21.258}, {170.,            20.1175}, {171., 19.0709}, {172., 18.0847}, {173., 17.1751}, {174.,            16.3173}, {175., 15.5259}, {176., 14.7758}, {177., 14.076}, {178.,            13.4098}, {179., 12.7869}, {180., 12.1926}, {181., 11.6359}, {182.,            11.1054}, {183., 10.6106}, {184., 10.141}, {185., 9.7062}, {186.,            9.29656}, {187., 8.922}, {188., 8.57166}, {189., 8.25434}, {190.,            7.95882}, {191., 7.69154}, {192., 7.44172}, {193., 7.21152}, {194.,            6.99187}, {195., 6.78149}, {196., 6.57857}, {197., 6.38792}, {198.,            6.20788}, {199., 6.0449}, {200., 5.89388}, {201., 5.758}, {202.,            5.62656}, {203., 5.49434}, {204., 5.36374}, {205., 5.23765}, {206.,            5.11653}, {207., 5.00326}, {208., 4.89584}, {209., 4.79588}, {210.,            4.70075}, {211., 4.61033}, {212., 4.52086}, {213., 4.43049}, {214.,            4.33572}, {215., 4.23482}, {216., 4.13749}, {217., 4.04895}, {218.,            3.96654}, {219., 3.89063}, {220., 3.81765}, {221., 3.74721}, {222.,            3.67986}, {223., 3.61563}, {224., 3.55026}, {225., 3.48314}, {226.,            3.41624}, {227., 3.34984}, {228., 3.28314}, {229., 3.2159}, {230.,            3.14784}, {231., 3.08}, {232., 3.01543}, {233., 2.95542}, {234.,            2.90456}, {235., 2.85808}, {236., 2.81372}, {237., 2.76943}, {238.,            2.72368}, {239., 2.67735}, {240., 2.6309}, {241., 2.58498}, {242.,            2.54007}, {243., 2.49639}, {244., 2.45405}, {245., 2.41249}, {246.,            2.37127}, {247., 2.32927}, {248., 2.28662}, {249., 2.24441}, {250.,            2.20277}, {251., 2.16184}, {252., 2.12168}, {253., 2.0829}, {254.,            2.04515}, {255., 2.00862}, {256., 1.97252}, {257., 1.93656}, {258.,            1.90105}, {259., 1.8665}, {260., 1.83418}, {261., 1.80359}, {262.,            1.77372}, {263., 1.74444}, {264., 1.71617}, {265., 1.68854}, {266.,            1.66149}, {267., 1.63461}, {268., 1.60756}, {269., 1.5805}, {270.,            1.55363}, {271., 1.52752}, {272., 1.50251}, {273., 1.47878}, {274.,            1.45619}, {275., 1.43259}, {276., 1.40649}, {277., 1.38075}, {278.,            1.35628}, {279., 1.33193}, {280., 1.30753}, {281., 1.28371}, {282.,            1.26006}, {283., 1.23519}, {284., 1.21085}, {285., 1.18961}, {286.,            1.16996}, {287., 1.15244}, {288., 1.13717}, {289., 1.12452}, {290.,            1.11253}, {291., 1.10009}, {292., 1.08708}, {293., 1.07289}, {294.,            1.05803}, {295., 1.04329}, {296., 1.02881}, {297., 1.01485}, {298.,            1.00133}, {299., 0.98825}, {300., 0.97555}, {301., 0.96326}, {302.,            0.95127}, {303., 0.93939}, {304., 0.92759}, {305., 0.91595}, {306.,            0.90446}, {307., 0.89313}, {308., 0.88195}, {309., 0.87097}, {310.,            0.86024}, {311., 0.84998}, {312., 0.84021}, {313., 0.83063}, {314.,            0.82119}, {315., 0.81193}, {316., 0.80287}, {317., 0.79377}, {318.,            0.78453}, {319., 0.77542}, {320., 0.76659}, {321., 0.75783}, {322.,            0.74902}, {323., 0.74036}, {324., 0.73211}, {325., 0.72417}, {326.,            0.71666}, {327., 0.70927}, {328., 0.70162}, {329., 0.69383}, {330.,            0.68607}, {331., 0.67845}, {332., 0.67127}, {333., 0.66448}, {334.,            0.65796}};          EHN[T_] := E\[Infinity] + (E0 - E\[Infinity])/(1 + (I \[Omega] 10^(-((C1 (T - T0))/(C2 + (T - T0)))))^\[Alpha])^\[Beta];          fitRe=FindFit[dataRe,Re[EHN[T]],{{\[Alpha], 0.2}, {\[Beta], 0.6}, {E0, 4}, {E\[Infinity], 8000}, {C1,                17}, {C2, 50}, {\[Omega], 10}}, {T}}];         fitIm=FindFit[dataIm,Im[EHN[T]],{{\[Alpha], 0.2}, {\[Beta], 0.6}, {E0, 4}, {E\[Infinity], 8000}, {C1,                17}, {C2, 50}, {\[Omega], 10}}, {T}}];         Show[ListPlot[dataRe, PlotStyle -> Red], Plot[Re[EHN[T]] /. {fitRe}, {T, 1, 200}]]         Show[ListPlot[dataIm, PlotStyle -> Orange], Plot[Im[EHN[T]] /. {fitIm}, {T, 1, 250}]]      * * * However,I cannot fit the Real part and the Imaginary part well.Here is one of my fitted picture: ![enter image description here](http://i.stack.imgur.com/wPpTQ.png) Is there any method,which I can fit both the Re and Im part. Thanks.