title: Manipulate Iterated Logarithm

text: Could I create a third slider that controls two other sliders? I would like to master slider to move slider `k` from min to max, at which point, the master slider should be half way across. Slider `j` should then "engage", and run from min to max, by which time, the master slider should be at max. I should also like to hide sliders `k` and `j`, so that only the master slider is visible. Is this possible?               r = 100; Manipulate[Plot[{If[k < E, Log[Log[x]/Log[k]], 0],     If[k == E,Log[Log[Log[x]/Log[j]]], 0], Log[x], Log[Log[x]], Log[Log[Log[x]]]},      {x, 1, r}, PlotRange -> {{0, r}, {0, Log[r]}}, PlotStyle -> {{Blue}, {Blue},      {Red, Dashing[0.005], Opacity[0.3]}, {Red, Dashing[0.005], Opacity[0.3]}, {Red,      Dashing[0.005], Opacity[0.3]}}], {k, x^(1/x), E}, {j, x^(1/x), E}]      # Update This is the closest I can get. Not perfect, but better ...               r = 100; j = x^(1/x); Manipulate[Plot[{If[k < E, Log[Log[k, x]],      Log[Log[Log[k - E + x^(1/x),x]]]], Log[x], Log[Log[x]], Log[Log[Log[x]]]}, {x, 1, r},       PlotRange -> {{0, r}, {0, Log[r]}}, PlotStyle -> {{Blue}, {Red, Dashing[0.005],      Opacity[0.3]}, {Red, Dashing[0.005], Opacity[0.3]},{Red,Dashing[0.005],      Opacity[0.3]}}], {k, x^(1/x), 2 E - 1}]      # Update 2 From Belisarius' great code below:               r1 = 1; r2 = 100; j = 3;      Manipulate[Plot[{NestList[Log, Log[x]/Log[(1 - Mod[s, 1]) x^(1/x) + Mod[s, 1] E],      Floor[s + 1]][[Floor[s + 1]]], NestList[Log, x, j]}, {x, r1, r2},     PlotRange -> {{r1, r2}, {0, Log[r2]}}, Axes -> False, Frame -> True], {s, 0, j}]      Title changed to make it more fitting to question. Apologies to Martin John Hadley and bill s for misleading original title: **Create master slider in manipulate & hide others** _this was my first thought on how to approach this problem_. Thank you for your excellent responses, though.


title: How to parse a .css file generated by Mathematica? modify values, add some values

text: How to parse a .css file generated by Mathematica (Export notebook to HTML)? modify values, add some values. convert into a expression? Are there some instances? I've wrote a simple function to add some values to a .css file.               ImportTxt[file_, Elements_: "String"] :=  Module[{file1 = file, absoluteFileName,    fileNameTxt}, (fileNameTxt = ((FileNameDrop[           absoluteFileName = AbsoluteFileName[#]] <> "\\" <>           FileBaseName[#]) &@file) <> ".txt");   If[FileExistsQ[fileNameTxt], DeleteFile[fileNameTxt];    CopyFile[file, fileNameTxt]; Import[fileNameTxt, Elements],    CopyFile[file, fileNameTxt]; Import[fileNameTxt, Elements]]]          ExportCSS[file_, content_] :=  Module[{fileTxt = file <> ".txt", fileCss = file <> ".css"},   Export[fileTxt, content];   If[FileExistsQ[fileCss], DeleteFile[fileCss];    RenameFile[fileTxt, fileCss], RenameFile[fileTxt, fileCss]]]          cssAdd[cssFile_, name_, value_] :=  Module[{cssFileTxt},   If[FileExistsQ[cssFile] == False, Print["File-Not-Exists"];    Abort[]]; cssData = ImportTxt[cssFile, "Data"];   cssDataList =    Partition[SplitBy[cssData, StringMatchQ[#, "/*" ~~ __ ~~ "*/"] &],     2];  pos = Position[cssDataList, "." <> name <> " {"][[1]];  result = Insert[cssDataList, value, pos + {0, 0, 1}];  ExportCSS[cssFile // StringDrop[#, -4] &,    StringJoin@Map[Riffle[#, "\n"] &, result, {1, 2}]]]      For example:               cssAdd["index", "Text", "width:300px;"]      will add the value "width:300px" to the css file. The problem is the manipulation can not do repeatedly. Now we continue to change the value `width:300px;` into `width:500px;` The first value added is 300px; the second value is 500px; however, in .css file, the same value only take effect in the after. ie. width:300px; will override the width:500px; In my code： I use `pos + {0, 0, 1}` to get the position where to insert a new value, it is not good.It is hard to find the right place to insert(...Let me try Reverse a sublist...)               width:500px;          width:300px;      more completely show:               .Text{      width:500px;     width:300px;     padding:8px;     }      The right one should be               .Text{      width:300px;     width:500px;     padding:8px;     }      * * * How to develop my function or other better functions/methods? for example, The first question is Import as "String" or "Data"? Since `PageWidth` doesn't seem to take effect after exporting to HTML, I need manually map the value of `PageWidth` to the `width` in.css file. * * * Update one of my solution: I find the place of "}" after ".Text {"               pos1=Position[cssDataList,"."<>name<>" {"][[1]];     level=pos1[[1;;2]];     pos2=Select[Position[cssDataList,"}"][[All,-1]],#>pos1[[-1]]&]//First;     result=Insert[cssDataList,value,Append[level,pos2]];


title: shortcut conflict: My Default Stylesheet was broken by one of my personal stylesheet?

text: My Default Stylesheet was broken by one of my personal stylesheet? I've added one shortcut to one of my stylesheet, Ctrl+Shift+I, to change a style of cell into style named `Image`. For example, it looks like the following output cell.               cellExpression=Cell[i,"Image"];CellPrint@cellExpression      However, now my default stylesheet also has this shortcut. ### question1 * * * why? how to remove it in my default stylesheet? ### question2 * * * Is it possible make only Alt+Shift+I take effect to change cell style, Alt+I to `Insert` a picture, still work for menu bar. ### question3 * * * one aside: My shortcut of Alt+Shift+... to change style type works well under windows, but doesn't work well under Ubuntu in VMWare, what's your cases and how to fix it.


title: Kramers Kronig Relation for Phase and Complex Reflectivity

text: I am a new user to _Mathematica_ and I have been trying to figure out how to find $\Theta(\omega)$ from my 'experimental' values of energy and $\ln(\sqrt{R(\omega)})$ (I am just running a simulation, letting $R$ to be a Lorentizan curve and energy be $0\,\text{eV}$--$10\,\text{eV}$, with $0.001$ interval). The following are the equations I used: $$ \ln(r(\omega)) = \ln\left(\sqrt{R(\omega)}\right) + \mathrm{i}\,\Theta(\omega) $$ and by KK relation, $$ \Theta(\omega) = -\frac{\omega}{\pi} \int_{0}^{\infty}\frac{\ln\left(\sqrt{R(x)}\right) - \ln\left(\sqrt{R(ω)}\right)}{x^2-\omega^2}\,\mathrm{d}x, $$ These equations can be found from this website: http://dept.phy.bme.hu/education/optical_spectroscopy/lecture2_rev.pdf (pg5) and the physical meaning of $R$ is the reflectivity, and $\Theta(\omega)$ is the phase difference between $R$ and $r$, the reflection coeffecient. The following is my 'data'. http://pastebin.com/VfLDk7Lh. The data is already in $\ln(\sqrt{R})$, energy. Here is the code that I have keyed into mathematica.               {Reflec, w} = ToExpression@Import["C:\\Users\\user\\Desktop\\1.txt"];          f = Interpolation[Transpose[{Flatten[w], Flatten[Reflec]}]]          delta[w_] :=      delta[w] = -2 w/Pi NIntegrate[(f[a] - f[w])/(a^2 - w^2), {a, 0, 10},      Method -> "PrincipalValue", Exclusions -> {(a^2 - w^2) == 0}] //      Quiet          Table[delta[w], {w, 0, 10, 0.1}]       _Mathematica_ is able to give me some values $\Theta(\omega)$. However, when I calculated the dielectric $\varepsilon_2$ with another program IGOR, there are some negatives values. Hence, I would like to find out if there are anything wrong with the commands I typed in _Mathematica_.


title: Hyperlink shrink the image, how to make the image become original size

text: I found that               Hyperlink[im, "something", ImageSize -> 800]      The `ImageSize` only add some borders of my `im`. How to make my im become the actual size? You can try a big image.


title: Compiling more functions that don't call MainEvaluate

text: I would like to use Compile with functions defined outside Compile. For example if I have the two basic functions F and G               F[x_] := x + 2     G[x_] := x      And I want to compute F[G[x]] in Compile               compiledFunction = Compile[{{x, _Real, 0}}, F[G[x]] ]      The resulting compiled function calls MainEvaluate               FastCompiledFunctionQ[function_CompiledFunction]:=     (         Needs["CompiledFunctionTools`"];         StringFreeQ[CompiledFunctionTools`CompilePrint@function,"MainEvaluate"]     )          compiledFunction // FastCompiledFunctionQ      Returns False, where FastCompiledFunctionQ checks if a compiled function calls MainEvaluate (in order to use normal Mathematica kind of code instead of one compiled using Compile), which is usually slower than compiled code. Is there a way to go around this ? More generally I want to compile almost any numerical Mathematica code that calls user defined functions (which themselves can call other user defined functions) and doesn't use symbolic computations.


title: What does the Error Message in DSolve really mean?

text: Having this ordinary non linear differential equation $$y'-x^2 (y+1)\cdot (y+2)^2= 0$$ with the boundary condition $y(4)=2$. When trying to solve this one with Mathematica by using               DSolve[{y'[x] - x^2 (y[x] + 1) (y[x] - 2)^2 == 0, y[4] == 2}, y[x], x]      it gives an empty set of solution and returns               DSolve::bvnul: For some branches of the general solution, the given boundary conditions lead to an empty solution. >>      As we have $$y'=x^2(y+1)\cdot (y+2)^2$$ which is clearly lipschitz continuous hence local a unique solution exists. In special $$y=2 \quad \forall x$$ is a solution of the differential equation. When using `NDSolve`and plotting the results it looks pretty much like the constant function which solves the ode. How does it come that Mathematica says there is no solution? I am using Mathematica 9.0.1 (Student Edition).


title: Normal[Series[ ]] does not give a normal expression

text: Let us say I want to show how the Taylor's series for Sin behaves:               In[94]:= Plot[Normal[Series[Sin[x], {x, 0, 3}]], {x, -\[Pi], \[Pi]}]          During evaluation of In[94]:= General::ivar: -3.14146 is not a valid variable. >>         During evaluation of In[94]:= General::ivar: -3.14146 is not a valid variable. >>         During evaluation of In[94]:= General::ivar: -3.14146 is not a valid variable. >>         During evaluation of In[94]:= General::stop: Further output of General::ivar will be suppressed during this calculation. >>      However, if I just evaluate               In[95]:= Normal[Series[Sin[x], {x, 0, 3}]]          Out[95]= x - x^3/6          In[96]:= Plot[x - x^3/6, {x, -\[Pi], \[Pi]}]          Out[96]=      ![enter image description here](http://i.stack.imgur.com/Thm8t.png) It works fine. What is going on? I am doing this because I want to insert the plot in a Manipulate and then see how the functions behave with more terms of the series. **Update:** Using the answer, I can do               Plot[Evaluate@Normal[Series[Sin[x], {x, 0, 3}]], {x, -\[Pi], \[Pi]}]      However, if I try to compare as in               Plot[{Sin[x], Evaluate@Normal[Series[Sin[x], {x, 0, 3}]]}, {x, -\[Pi], \[Pi]}]      it doesn't work while the explicit `Plot[{Sin[x], x - x^3/6}, {x, -\\[Pi], \\[Pi]}]` does.


title: how to reduce the time to calculate triple integral

text: i want to evaluate the following integral, but it takes 15 min to do it. i must reduce the time to calculate it, i have to do a table and create a graph, but takes too long. anyone have an idea ? can i use mathlink to import the FORTRAN to do it ?               minroot[g_?NumericQ, b_?NumericQ] :=       Module[{rts, y},        rts = y /. Solve[g^2 - b^2*g^2  y - 4 y^6 + 4 y^3 == 0, y];        rts = Select[rts, With[{nval = N[#, 100]}, Im[nval] == 0 && nval > 0] &];        Min[rts]^(1/2)];          aA[g_?NumberQ, b_?NumberQ] :=        Pi - 2 b g NIntegrate[ 1/Sqrt[g^2 - b^2*g^2  y^2 - 4*y^12 + 4  y^6],                                                                 {y, 0, minroot[g, b] - 0.00001}];          qQ[g_?NumberQ] := NIntegrate[2*(1 - Cos[aA[g, b]]) b, {b, 0, 10}];          o[T_] = (1/T^3) NIntegrate[(g^5*qQ[g]) / E^(g^2/T), {g, 0, 50}];          o[4]      thanks for any help


title: How to use PlotRange -> All with ListLogLinearPlot?

text: I would like to generate a `ListLogLinearPlot` that automatically shows all the data points. However the option `PlotRange -> All` does not achieve this. Why does `All` not include all of the data in this case? For Example:               x = Range[0.001, 1000];     y = 5 - Log[x];     ListPlot[Transpose[{x, y}], PlotRange -> All]     ListLogLinearPlot[Transpose[{x, y}], PlotRange -> All]      In the resulting plots, the `ListPlot` looks as expected: ![listplot](http://i.stack.imgur.com/A9ZmL.png) but the `LisLogLinearPlot` cuts off several points on the left: ![listloglinearplot](http://i.stack.imgur.com/j7esZ.png)


title: Find Determinant/or Row Reduce parameter dependent matrix

text: I'm trying to find the determinant of a band diagonal matrix that has a parameter, $\kappa$, in some of the entries. Some entries are just numerical ones, others ($\kappa$ X number), while others are ($\kappa$ + number). I have been told that they way to solve for $\kappa$ is to find the determinant of the this matrix and then find values of $\kappa$ that make the determinant zero. The main issue I'm having is that when my matrix becomes large the determinant just results to zero,and in other cases to calculation overflow. (I'm trying to work out all the bugs in the code, so det =0, might be some error I'm making, but the overflow error is not avoidable). I have already tried an `LUDecomposition` on the matrix, and that seems to take forever, I don't have a problem waiting, but working out the scaling, it seemed like I would have to wait a couple of days for a 500X500 matrix, and my real problem might have to be done on a 1000X1000 matrix. I was also thinking that maybe I could somehow get the matrix into an upper triangular form and then just multiply the diagonal elements. For this I tried using _Mathematica's_ `RowReduce` command, but for some weird reason that just results in the identity matrix. I thought that `RowReduce` might give me an upper triangular matrix with $f(\kappa)$ on the diagonal, and I could just multiply the diagonal elements and get a polynomial for $\kappa$ and solve. Any and all help is greatly appreciated. I'm not really sure how to put up my code, or the matrix for that matter. That is the thing that would probably help you guys the most. If there is a way for me to put up the matrix please let me know. Thanks again. EDIT- A matrix that gives you guys some idea of my matrix.               t2 = {{-892.33, 973.21, 44.306 + \[Kappa], -81.103,0},       {446.12, -557.94, 0, -682.54, -314.89},       {0,893.37, -506.68*\ [Kappa],-391.457, 0}, {0, 429.78, 0, -210.47,       342.85}, {278.32*\[Kappa], 0, 963.41, 217.71, -342.68 + \[Kappa]}}       **2nd-EDIT** Although I do not fully understand what Jens' code is doing I did try it on my real matrix. The result is               In[193]:= f[\[Kappa]_?NumericQ] :=       Min[Diagonal[SingularValueDecomposition[mat][[2]]]]     In[194]:= Plot[f[\[Kappa]], {\[Kappa], 0, 2}]      Well being a noob the site won't let me upload an image, but it basically looks like there should be roots around $\kappa$ = .1, .2, .4,.4, .6. So I tried to find the root using               In[196]:= FindRoot[f[x], {x, .5}]      And then I get a bunch of error messages.               During evaluation of In[196]:= InterpolatingFunction::dmval:     Input value {-0.173686} lies outside the range of data      in the interpolating function.Extrapolation will be used. >>          During evaluation of In[196]:= InterpolatingFunction::dmval:      Input value {-0.173686} lies outside the range of data in the      interpolating function. Extrapolation will be used. >>          During evaluation of In[196]:= InterpolatingFunction::dmval:      Input value {-0.173686} lies outside the range of data      in the interpolating function. Extrapolation will be used. >>           During evaluation of In[196]:= General::stop: Further output of         InterpolatingFunction::dmval will be suppressed during this calculation. >>           Out[196]= {x -> -3.28829*10^-13}      So I figured that if root-finder couldn't do it, I'd just try it by hand, i.e. just look at the plot and keep narrowing down the point where f($\kappa$) =0, so I tried to evaluate                In[190]:= f[.2]      which was taking forever considering that this command               In[193]:= f[\[Kappa]_?NumericQ] :=      Min[Diagonal[SingularValueDecomposition[mat][[2]]]]      and the plot command both took less than an second. I'm very confused. **3rd Edit** I think I can post a picture now. So I will include my plot for `f[x]`. This might make it easier to figure out what is going wrong with root- finder. I'm thinking its the multiple roots. ![enter image description here](http://i.stack.imgur.com/bDhDX.png) **4th Edit** Hi All, Happy almost 4th of July, There is some good news and some bad news about the code thus far. The good news is that it seems to be working fine for larger grid sizes. I haven't cranked it up too much b/c my computer can't really handle it. The bad news is that I'm getting complex solutions. I know that the physical problem I am dealing with should not have complex solutions. Therefore when I was implementing the code by finding det(mat($\kappa$)= 0 , and solving the resulting polynomial for the roots I was using `Solve[d1 == \\[Kappa], Reals]`, where `d1 = Det[mat]`. This allowed me to only examine the real roots. However using the code               g[x_?NumericQ] := Last[SingularValueList[mat /. \[Kappa] -> x]]     Plot[g[x], {x, .5, 2/3}]      Gives me the following plot ![SVD-updatedPlot](http://i.stack.imgur.com/EJEBq.png) and then I try `FindRoot[g[x], {x, .58, .55, .6}]`. Which results in `{x -> 0.580341}`, and the following error message               FindRoot::lstol: The line search decreased the step size to within tolerance         specified by AccuracyGoal and PrecisionGoal but was unable to find a      sufficient decrease in the merit function. You may need more than      MachinePrecision digits of working precision to meet these tolerances. >>      Which I looked up and is supposed to mean that root finder cannot find real roots. So my first question is: what does `{x -> 0.506739}`, mean if _Mathematica_ couldn't find real roots? I've also tried to increase the `AccracyGoal` and `WorkingPresicion` with this               FindRoot[g[x], {x, .58, .55, .6}, AccuracyGoal -> MachinePrecision,          WorkingPrecision -> 20]      Which results in a similar error.               FindRoot::lstol: The line search decreased the step size to within tolerance      specified by AccuracyGoal and PrecisionGoal but was unable to find a      sufficient decrease in the merit function. You may need more than 20.`      digits of working precision to meet these tolerances. >>      So I'm quite lost as to where to go now. I've gone through my code and made sure that I put everything in fractional form, i.e. 1/2 instead of .5 since I know that can reduce precision, and make _Mathematica_ angry. As an aside, I wanted to throw another question out there. From the plot we can see that there are many roots present. And that there will be even more when I make the grid-size larger. I've already restricted the values for $\kappa$ to what is physically possible (in the Plot command), but that stills results in 10 -20 roots. Is there any other way to know which root is the real physics answer? **5th Edit** New plot with Jens' suggestion used in code. ![SVD-plot3](http://i.stack.imgur.com/tWvBf.png) Now there are also no errors when I try the `FindRoot` command. **6th Edit,So this strange...or is it?** If I understand the procedure that we have worked out thus far, the plots that I created above tell me "how singular" my matrix is as a function of my parameter $\kappa$. Thus I would probably like my y-axis to be really small, and so I am telling `SingularValueList` to only give me the last entry since that should be the smallest singular value, and also why I'm using the tolerance function,so that the smallest value do not get ignored. One question is, why use tolerance if were are already looking at the smallest singular value? The other problem, the strange part, is that when I find a $\kappa$ using `SVL`, and root finding command, then write $\kappa = .508...$, and then `Det[mat]`, I get something like 2.14^113, and 1.678^109, for another root. Is that right? Is this essentially as close to zero as we can get the determinant? Or am I missing something huge. Is it that I am using the wrong root. Is there one that can give me Det = .0000001 or even smaller? I guess its not all bad news, this smalleness of the Det could help me figure out which is the true root. Anyways just throwing some thoughts/questions out there. Thanks again to all who respond. This problem is starting to drive me crazy but I guess that research.


title: Inverse Laplace transform not obtained

text: I can't seem to be able to compute the inverse Laplace transform of a Laplace transform:               LaplaceTransform[x *  Sqrt[l^2 - x^2], x, s]          Out[27]= -(1/(32 π))      Sqrt[-(1/l^2)] l^4 (l^2)^(3/2)        s^3 MeijerG[{{-(3/2)}, {}}, {{-3, -(3/2), -1}, {}}, -(1/16)           l^4 s^4 Sign[Im[Log[-(1/l^2)]]], 2] Sign[Im[Log[-(1/l^2)]]]      But if I try to do the reverse:               InverseLaplaceTransform[-(1/(32 π)) Sqrt[-(1/l^2)]        l^4 (l^2)^(3/2)        s^3 MeijerG[{{-(3/2)}, {}}, {{-3, -(3/2), -1}, {}}, -(1/16)           l^4 s^4 Sign[Im[Log[-(1/l^2)]]], 2] Sign[        Im[Log[-(1/l^2)]]], s, x]          Out[29]= -(1/(32 π))      Sqrt[-(1/l^2)] l^4 (l^2)^(3/2)        InverseLaplaceTransform[        s^3 MeijerG[{{-(3/2)}, {}}, {{-3, -(3/2), -1}, {}}, -(1/16)             l^4 s^4 Sign[Im[Log[-(1/l^2)]]], 2], s, x] Sign[        Im[Log[-(1/l^2)]]]      Shouldn't this evaluate to the original? As to why I'd want to do this: I am trying to solve an equation using Laplace transforms.


title: Efficient backtracking with Mathematica

text: > Backtracking is a general algorithm for finding all (or some) solutions to > some computational problem, that incrementally builds candidates to the > solutions, and abandons each partial candidate _c_ ("backtracks") as soon as > it determines that _c_ cannot possibly be completed to a valid solution. > (from Wikipedia) In pseudo-code, a backtracking algorithm looks something like this:                procedure bt(c)        if reject(P,c) then return        if accept(P,c) then output(P,c)        s ← first(P,c)        while s ≠ Λ do          bt(s)          s ← next(P,s)      Here,   1. `root(P)`: return the partial candidate at the root of the search tree.   2. `reject(P,c)`: return `true` only if the partial candidate `c` is not worth completing.   3. `accept(P,c)`: return `true` if `c` is a solution of `P`, and `false` otherwise.   4. `first(P,c)`: generate the first extension of candidate `c`.   5. `next(P,s)`: generate the next alternative extension of a candidate, after the extension `s`.   6. `output(P,c)`: use the solution `c` of `P`, as appropriate to the application. The backtracking algorithm then starts with the call `bt(root(P))`. I'm trying to program this as efficiently as possible in Mathematica. I have already coded the pertinent `root`, `reject`, `accept`, `first`, and `next` functions. Since I only need to obtain one solution, I am doing the `output` through a `Throw`, `Catch` combo. Given that one has the basic logic of `root`, `reject`, ..., already coded, are there alternative ways to program the backtracking loop (procedure `bt` above) in Mathematica? What I have in mind is a substitution of `while` with something more Mathematica friendly, such as `Fold` or `Map`, but I have no idea of how to do this.


title: NIntegrate failed to converge?

text: Hey guys I have a pretty simple code that consists of an RMS calculation. The issue is that I am getting quite a few error messages when I run it. The following equations are highly published physics equations with confirmed results, so I am at a loss of why mathematica will not give me an answer:               lambda[z_] := Exp[-(z^2/2^2)]     fo[x_?NumericQ] :=      NIntegrate[     1/(x - xprime)^(1/3) lambda'[xprime], {xprime, -Infinity, x}]     rms[y_] :=      Sqrt[NIntegrate[     lambda[x]*(fo[x])^2, {x, -y, y}] - (NIntegrate[     lambda[x]*(fo[x]), {x, -y, y}])^2]          rms[Infinity]


title: How to add a column to a table that counts the number of times the lines appear?

text: I am at a complete loss at this. I have a table with 2 columns and _n_ lines. Some of the lines are repeated. What I want to do is add a new column that counts the number of repetitions of each line. Example               a={{1.1, 2.2},{1.1, 2.2}}      then I need something that will add a column `{2,2}` to the end of the table, resulting in               {{1.1, 2.2, 2},{1.1, 2.2, 2}}      Keeping in mind that I don't know in advance how many times a line will appear in the table. If it helps, the same line will always appear in subsequent positions Thanks


title: Quickly reducing the number of decimal digits for a set of real numbers

text: How can I quickly convert a number with $n$ decimal points to a number of with $m$ decimal points? `Round` works, however, it is slower than I would like. This example rounds a set of $100$ real numbers to $0.1$ decimal precision:               testvalues = Table[{RandomReal[], RandomReal[]}, {i, 1, 100}]          t1 = AbsoluteTime[];          For[i = 1, i <= 10^5, i++,       Round[testvalues, 0.1];     ];          t2 = AbsoluteTime[];          t2 - t1      Takes $\approx 11.87$ seconds on my 3.47 GHz CPU. `Floor` and `Ceiling` take a commensurate amount of time.


title: Remove braces, {}, from around DynamicModule output?

text: Is there a way to remove the braces from the front end output associated with `DynamicModule`? For instance:               a=0;     DynamicModule[{x}, {Slider[Dynamic[x]], Dynamic[If[x>.5,a=1;,{}]]}]      This returns a slider with braces around it. Is there a way to avoid or remove the braces?


title: Piping and Replacement

text: I haven't been able to figure out how to use piping with certain functions. Specifically, I would like to apply a replacement at the end of a pipe, like the following:               (x^2 + y + Log[z])^2 /. {y -> x/2} // Expand /. {z -> E^x}      Also, is there a general rule that I should know about piping that would help me in the future with problems like this?


title: Standard deck of 52 playing cards in curated data?

text: I am not sure how to find out what all is included as curated data. For example, are the individual images of each of the 52 cards in a standard deck of playing cards included? If not, is there a way to systematically access these from web images?


title: Two discrete colors for surface with ParametricPlot3D

text: I am trying to create a plot of a surface that is yellow above the xy-plane (z>0), but blue below (z<0). My first attempt was to use `ColorFunction->Function[{x,y,z},If[z>0,Hue[0.2],Hue[0.6]]`, but this only gave me a solid yellow paraboloid. I also tried defining a custom ColorFunction scheme with `cf=Piecewise[{{Yellow,0<#3<30},{Blue,-70<#3<0}}]&;` and `ColorFunction->cf` to the same result. Finally, I tried the following based on another thread (Discrete coloring in Plots):               ParametricPlot3D[{x,y,x^2+y^2-5},{y,-3,3},{x,-3,3},PlotStyle->Opacity[.8],ColorFunction->(If[#3>0,Yellow,Blue]&),Mesh->False,BoundaryStyle->{Black,Thickness[.01]}]      Every time, I end up with this: ![yellow paraboloid](http://i.stack.imgur.com/S5t0m.jpg) Any help you can offer would be greatly appreciated.


title: how to rewire the minimum number of edges in a disconnected bipartite graph, so to transform it in a connected one

text: Consider an incidence matrix A for a bipartite graph (Aij=1 if node i of group 1 and node j of group 2 are connected). A is not symmetric. Assume that A is disconnected or only weakly connected, i.e. there is at least one in-degree or one out-degree (or both) that are zero. I'm trying to write a function that as input as the matrix A, and the output is a new matrix A', that has the same number of nodes and edges, but it is strongly connected (both in and out degree are different from zero). I want to achieve this result by rewiring the minimum number of edges in the network. The function I have developed is the following one:               bipRanGraphConn[matrix_] :=      Module[{row, col, a, l, pos0row, xy0row, xy1row, row1, rulerow,      pos0col, xy0col, xy1col, col1, rulecol, m, m1},      a = Sign[matrix]; {row, col} = Dimensions[matrix]; l = Total[a, 2];      m = Partition[Nest[RandomSample, Flatten[matrix], 10],      Dimensions[matrix][[2]]];      pos0row = Position[Total[m, {2}], x_ /; x == 0.];          row1 = Cases[GatherBy[Position[m, x_ /; x > 0.], First],      x_ /; Length[x] >= 2];     pos0row = Position[Total[m, {2}], x_ /; x == 0.];     pos0col = Position[Total[m], x_ /; x == 0.];     col1 = Cases[GatherBy[Position[m, x_ /; x > 0.], Last],      x_ /; Length[x] >= 2];          If[Length[pos0row] == 0. &&      Length[pos0col] == 0., m1 = m,     If[Length[pos0row] > 0. && Length[row1] > Length[pos0row],     xy0row =       Join[pos0row,        RandomChoice[Partition[Range[1, col], 1], Length[pos0row]], 2];     xy1row =       Flatten[RandomSample[#, 1] & /@         RandomSample[row1, Length[pos0row]], 1];     rulerow =       Flatten[Table[{xy0row[[i]] -> Extract[m, xy1row[[i]]],          xy1row[[i]] -> 0.}, {i, 1, Length[xy1row]}], 1];      m1 = ReplacePart[m, rulerow], m1 = m];      col1 = Cases[GatherBy[Position[m1, x_ /; x > 0.], Last],       x_ /; Length[x] >= 2];     If[Length[pos0col] > 0. && Length[col1] > Length[pos0col],     xy0col =       Join[pos0col,        RandomChoice[Partition[Range[1, row], 1], Length[pos0col]], 2];     xy1col =       Flatten[RandomSample[#, 1] & /@         RandomSample[col1, Length[pos0col]], 1];     rulecol =       Flatten[Table[{xy0col[[i]] -> Extract[m1, xy1col[[i]]],          xy1col[[i]] -> 0.}, {i, 1, Length[xy1col]}], 1];      m1 = ReplacePart[m1, rulecol]];]; m1     ]      In general it works well, but I find that in some cases, it fails and give me a matrix that is still only weakly connected. I appreciate if you can help me understand why does it fails, or if you have a better way to do it. Working case:               A={{0., 1., 0., 0., 0.}, {0., 1., 1., 1., 1.}, {1., 0., 0., 0.,         0.}, {0., 0., 1., 0., 0.}, {0., 0., 0., 0., 0.}, {1., 0., 0., 0.,         0.}, {0., 0., 0., 0., 0.}, {1., 1., 0., 0., 1.}, {1., 1., 0., 1.,         0.}, {0., 1., 1., 0., 0.}, {0., 1., 0., 0., 0.}, {1., 1., 1., 1.,         1.}, {0., 1., 1., 0., 0.}, {1., 1., 0., 0., 0.}, {0., 0., 0., 0.,         0.}, {1., 0., 0., 0., 0.}, {0., 1., 0., 0., 0.}, {1., 0., 0., 0.,         0.}, {1., 0., 0., 0., 0.}, {1., 0., 0., 0., 0.}, {0., 0., 0., 0.,         0.}}      Not Working case are usually for large matrix. This is the not working case (most of the times) that has the smaller size:               A= {{0., 0., 0., 1., 0., 1., 0., 1., 0., 0., 0., 1., 1., 0., 0., 0., 0.,      1., 1., 0., 0., 0., 0., 1., 1., 0., 1., 1., 1., 0., 1., 0., 1., 1.,      0., 0.}, {0., 1., 1., 1., 1., 0., 0., 0., 1., 0., 0., 0., 0., 0.,      0., 0., 0., 0., 0., 1., 0., 1., 0., 0., 0., 1., 0., 0., 0., 0., 0.,      1., 0., 0., 0., 0.}, {1., 0., 1., 0., 0., 0., 1., 0., 0., 0., 1.,      1., 0., 0., 0., 0., 0., 1., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,      0., 0., 0., 0., 0., 0., 1., 1.}, {0., 0., 0., 1., 0., 0., 1., 0.,      1., 0., 0., 0., 0., 1., 0., 0., 0., 0., 0., 0., 1., 0., 1., 0., 0.,      0., 0., 0., 0., 1., 0., 0., 0., 0., 0., 0.}, {1., 0., 0., 0., 1.,      0., 1., 0., 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., 0., 0.}, {1., 1.,      0., 0., 0., 0., 0., 0., 0., 1., 0., 0., 0., 0., 1., 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., 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., 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., 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., 0., 0., 0., 0., 0., 0., 0.}, {0., 1., 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.}, {0., 0., 0.,      1., 0., 0., 0., 1., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,      0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,      0.}, {0., 0., 1., 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., 0.,      0., 0., 0., 0.}, {0., 0., 0., 0., 1., 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., 0., 0., 0., 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., 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., 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., 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., 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., 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., 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., 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., 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., 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., 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., 0., 0., 0., 0.}, {1., 0., 0., 0., 0., 0.,      0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,      0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}}


title: Number with no decimal mark

text: I'm using _Mathematica_ to create some images and labeling them after a simple calculation done previously. As the name of the file depends on the result, I want to show it with no decimal separator (because the "." can be a program as I'll use these images later on LabView). I'm using the following code: `ang = NumberForm[N[frac], {5, 2}]` where the result has 5 precise digits and 2 digits to the right of the decimal. Then, I'm doing `angle = ang*100`, but I still get the decimal marker but no number after it. How can I get rid of this?


title: Controlling the speed of Manipulate animations exported to SWF

text: I would like to export in .swf a "Manipulation" output. I am using                Export["Pi.swf", Manipulate[SeedRandom[n];       data = RandomReal[{-1, 1}, {m, 2}];       insidepts = Cases[data, {x_, y_} /; x^2 + y^2 < 1];       inside = Length[insidepts];       Text@Style[         Column[{Graphics[{PointSize[0.0001], Red, Disk[{0, 0}, 1], Blue,              GeometricTransformation[              Line[{{Offset[{-2, 2}, {0, 0}],                  Offset[{2, -2}, {0, 0}]}, {Offset[{-2, -2}, {0, 0}],                  Offset[{2, 2}, {0, 0}]}}], Dynamic[data]]},             ImageSize -> If[format, 500, 350]],            Row[{"inside: ", inside, "\toutside: ", m - inside, "\ttotal: ",              m}], Row[{"π=4 x ", inside, "/", m, " = ", 4. inside/m}]}],          "Label"], {{n, 1, "random seed"}, 1, 1000, 1,         Appearance -> "Labeled"}, {{m, 1, "sample size"}, 1, 5000, 1,         Appearance -> "Labeled"}, {{format, False, "large format"}, {True,          False}}, AutorunSequencing -> {1, 2}]]         I think it is too fast... Is there a way to modify speed?


title: Is Table the only functional way to construct nested loops in Mathematica?

text: Suppose you have a cubic box containing identical particles and you want to compute the distances between each particle and every other particle in the box without double-counting (i.e., if you've computed the distance between particles 1 and 2, you don't want to repeat the computation for particles 2 and 1 when looping through 2). In C-style languages you could do something like:               for ( int i = 0; i < nparticles - 1; i++ )     {         for ( int j = i + 1; j < nparticles; j++ )         {            //calculate distance and some other stuff         }     }      In Mathematica you could do the following:                 ParallelTable[Distance[coord[[i]], coord[[j]], z],                                  {i, 1, nparticles - 1}, {j, i + 1, nparticles}]      Where `Distance` is a function that takes in the positions of two particles and a `boxsize` variable and spits-out the distance between them. Is there a better, more elegant Mathematica-way to achieve this? I've tried using `Outer` to no success. To give a specific example:               coord = {{0.336384, 0.0132788, 0.895366}, {0.531722,        0.703736, -0.626689}, {1.3723, 0.191368,        0.930669}, {1.92434, -0.561288, 0.537316}, {2.48175, 1.34384,        0.368834}, {1.91778, 0.489024, -0.138269}, {3.22166, 1.46687,        1.16486}, {3.16976, -0.134968, 1.46946}, {3.31118, 0.625944,        0.0811552}, {4.39825, 1.03799,        0.985738}, {2.68123, -0.180248, -0.110539}, {4.68779, 0.22483,        0.0725717}, {5.41664, 0.982811, 0.491087}, {6.43321, 0.624075,        0.167138}, {6.60217, 1.59568, 2.19137}, {5.48321, -0.612703,        1.54037}, {0.275933, 1.73027, -0.319963}, {1.16899,        2.62176, -0.426422}, {0.895252, 2.30479, 0.546692}, {1.32435,        1.46099, -0.247962}, {2.438, 1.54727, -1.84394}, {2.84289, 2.47839,        0.487663}, {0.947902, 2.01877, 1.65962}, {4.27311, 1.66672,        1.82603}, {3.51098, 1.72636, 0.209131}, {2.53455, 2.68654,        1.45134}, {3.79154, 1.91726, 3.06622}, {5.59738, 1.69974,        1.26923}, {4.74771, 2.06686, 0.627377}, {5.8998, 1.90073,        0.269334}, {3.76603, 2.71011, 0.018981}, {6.52431, 1.09702,        1.0249}, {0.514549, 4.44605, -0.926816}, {1.18538,        3.8988, -0.291136}, {-1.03715, 3.48421, -0.126283}, {2.15475,        3.24303, -0.291715}, {1.96754, 2.39311, 0.152853}, {2.28468,        4.21156, 0.0596945}, {1.41851, 4.21297, 1.93538}, {1.77912, 3.13171,        0.827817}, {3.40729, 3.67042, -0.335001}, {4.14912, 4.26701,        0.858455}, {3.42495, 3.43054, 0.832514}, {2.65226, 0.773315,        1.84478}, {4.50074, 3.62477, -0.228838}, {5.67743,        4.08899, -1.0032}, {4.98032, 2.56005, 1.60549}, {5.21301,        2.61515, -0.189593}, {-0.716714, 4.48811, -0.0695819}, {0.924003,        5.67242, 0.689366}, {1.02188, 6.33087, 1.77669}, {0.330792, 4.2462,        0.228187}, {1.79568, 5.98731, -0.447117}, {1.4538,        4.91975, -0.371939}, {1.49597, 5.34725, 1.68155}, {1.49152, 4.62994,        0.659604}, {4.00242, 4.6745, -0.284203}, {3.10622, 4.50629,        0.728059}, {3.87473, 5.84693, 1.31431}, {2.98275, 5.88126,        0.697273}, {4.87938, 4.86575, 0.0826803}, {6.47473, 5.84112,        1.05569}, {4.76077, 5.92404, 0.606916}, {6.4309, 3.70755,        0.813097}, {0.104133, 0.851572, 3.46545}, {0.551016, 0.780983,        1.69373}, {-0.594108, 2.62214, 1.8779}, {0.708406, -0.797156,        2.9291}, {2.0969, -0.257719, 1.69345}, {3.93626, -0.163324,        0.657445}, {0.781078, 1.36067, 2.66083}, {3.8494, 0.656096,        1.86343}, {4.30525, -0.0180448, 2.46287}, {4.80984, 0.218372,        1.24748}, {2.76467, -0.0677178, 2.53374}, {4.58791, -0.856503,        3.05766}, {5.59133, -0.108523, 0.470608}, {7.29888, 0.209516,        2.63152}, {5.34566, 0.991826, 4.06735}, {4.31354, 0.951664,        2.75418}, {0.786024, 0.835163, 0.374784}, {1.49562, 0.756177,        2.29413}, {-1.31348, 3.36, 2.05473}, {1.96944, 1.82599,        2.15945}, {1.75072, 1.30223, 1.27227}, {2.25839, 3.48229,        2.18914}, {0.348436, 2.50653, 2.4213}, {1.82846, 1.37269,        3.04588}, {3.31408, 2.12509, 2.05064}, {3.41257, 3.28132,        2.45043}, {2.73336, 1.98305, 2.98785}, {5.36672, 1.01905,        2.02999}, {4.49376, 3.19686, 0.674299}, {5.6424, 2.95267,        0.927283}, {4.58006, 2.97117, 2.42488}, {5.10568, 1.9436,        2.47794}, {0.0359706, 2.12641, 1.14963}, {0.136018,        3.47913, -0.546182}, {0.324015, 3.19016, 1.53741}, {-0.364055,        3.30565, 2.57457}, {0.639834, 3.29517, 0.505645}, {2.21284, 3.99436,        1.14992}, {1.21456, 3.05581, 2.09513}, {2.94578, 3.94601,        3.25965}, {3.09293, 3.99949, 1.79511}, {4.15348, 3.53126,        1.64667}, {3.17003, 4.95903, 2.7816}, {3.98937, 3.99651,        2.56071}, {4.79954, 4.84892, 3.01249}, {5.35644, 4.06114,        0.728884}, {6.14876, 5.29657, 1.8754}, {3.95394, 2.44156,        1.21713}, {0.00856939, 6.32042, 1.89394}, {-0.435331, 7.36044,        2.55351}, {0.19939, 5.0767, 3.33505}, {-0.347543, 4.13423,        1.7466}, {0.481867, 4.5129, 1.26472}, {2.29653, 4.50625,        2.36835}, {0.351039, 5.00868, 2.20155}, {1.53178, 3.70154,        2.98418}, {2.53732, 5.04177, 1.5255}, {3.72857, 4.78197,        1.72687}, {3.20208, 5.71681, 2.0526}, {5.32521, 6.78749,        2.3629}, {5.22618, 5.09716, 1.11705}, {5.94678, 7.11508,        1.51961}, {4.62847, 5.63837, 1.95489}, {6.28939, 4.82977,        0.848559}, {0.0461207, 1.93522, 3.25444}, {0.371978, -0.0986856,        3.58917}, {-0.461638, 1.25587, 4.47311}, {0.584499, -0.644038,        4.46688}, {2.48808, -0.420693, 3.44016}, {2.41666, 0.660956,        3.88881}, {1.55183, -0.235559, 2.81671}, {1.59083, -0.113905,        4.47863}, {3.60737, 0.284417, 3.38969}, {4.14487, 1.05219,        3.87699}, {4.27162, 0.351588, 4.8352}, {4.79354, 0.125734,        3.38844}, {5.27955, 0.079976, 4.41649}, {5.41948, 0.854351,        3.03103}, {5.22856, 0.775168, 5.21907}, {6.37806, 0.167375,        4.72112}, {-1.02014, 1.96112, 3.69853}, {-0.419047, 2.83171,        3.46298}, {-1.31457, 2.99279, 4.20992}, {2.44419, 0.358023,        4.95077}, {1.49318, 2.32455, 3.03509}, {0.432945, 4.0273,        3.6404}, {2.43741, 2.95397, 3.21087}, {3.14394, 1.4998,        3.86404}, {3.25509, 0.897897, 2.71971}, {4.45936, 3.20951,        3.55269}, {3.9792, 2.36403, 4.23043}, {4.70902, 1.5701,        4.75358}, {4.67827, 2.15833, 3.48814}, {5.44659, 2.80719,        3.058}, {5.12916, 3.09863, 5.67653}, {7.26935, 1.50287,        4.25862}, {-1.81989, 4.53932, 1.82345}, {0.556698, 3.93986,        2.51026}, {0.995211, 4.14387, 4.78229}, {0.27128, 3.07496,        4.3641}, {-0.718274, 3.82941, 3.61474}, {1.34653, 3.4258,        4.05185}, {0.666971, 2.94969, 3.26312}, {3.41411, 2.84055,        3.56064}, {2.67536, 5.2721, 3.64452}, {3.40383, 5.93004,        3.15271}, {4.1124, 6.19419, 3.95084}, {4.08112, 4.5837,        4.80518}, {4.98851, 3.90126, 2.90884}, {6.04449, 4.53769,        2.73099}, {5.45906, 5.56679, 2.58463}, {5.09465, 4.17775,        3.97109}, {-0.175458, 4.9133, 4.37999}, {0.880872, 5.07276,        4.35447}, {-0.131287, 5.91199, 5.42513}, {1.58653, 4.74081,        3.71834}, {1.36079, 5.03015, 2.71108}, {2.43226, 5.70154,        4.58147}, {1.42105, 5.88282, 3.64901}, {2.1028, 4.374,        4.68369}, {2.18209, 5.72639, 2.59178}, {5.44592, 6.0964,        3.55996}, {3.63535, 6.13173, 5.09292}, {4.66946, 5.20011,        4.01056}, {6.4787, 6.02617, 2.89552}, {6.054, 6.96222,        3.57906}, {6.46182, 5.96925, 3.94092}, {5.69617, 5.10088,        3.64138}, {0.615022, -0.027696, 5.42941}, {1.26461, 0.630006,        3.71384}, {0.883915, 1.42777, 5.47437}, {1.6792, 0.219376,        5.6289}, {2.59437, -0.684772, 5.60909}, {3.38078, 0.833026,        5.01004}, {2.84052, 0.573809, 5.90501}, {2.52553, 0.273467,        7.55756}, {4.41898, 0.696667, 5.85818}, {5.60858, 0.76452,        6.21228}, {5.74785, -1.1999, 7.01252}, {5.21135, -0.1117,        5.70978}, {4.66543, -0.919731, 4.87041}, {5.88829, 2.25357,        4.8022}, {6.3881, 1.00455, 5.545}, {6.22542, 0.0248028,        6.01928}, {0.586144, 0.520938, 4.41165}, {1.2068, 2.54395,        4.71756}, {0.436429, 2.33501, 5.52469}, {1.97207, 1.17024,        5.77531}, {2.25879, 3.04413, 5.01964}, {3.16137, 2.32338,        5.14988}, {2.02769, 2.28359, 5.84169}, {2.83295, 1.61539,        5.95777}, {3.8353, 1.69209, 5.8488}, {3.96829, 4.30873,        3.70322}, {2.99406, 2.69444, 6.18322}, {4.51472, 1.36171,        6.60083}, {3.63584, 3.42738, 4.39589}, {6.12614, 2.20446,        5.82261}, {4.02039, 2.78657, 5.66757}, {5.06004, 1.83423,        5.81263}, {1.10964, 3.21626, 5.41782}, {0.855608, 5.48462,        5.49}, {-0.571077, 3.27243, 5.29777}, {2.72265, 4.45985,        5.80695}, {1.48765, 1.09592, 4.7271}, {2.57181, 3.58383,        4.09092}, {1.85261, 3.99701, 5.63123}, {2.39584, 2.38821,        4.08817}, {3.14111, 4.4719, 4.37108}, {3.24159, 5.19853,        5.18419}, {2.9781, 5.51286, 6.43951}, {3.5866, 3.85079,        5.36787}, {4.57368, 3.59342, 4.68331}, {5.97774, 4.05604,        4.6439}, {4.63198, 4.10956, 5.6602}, {6.58299, 2.72811,        6.98548}, {-0.360483, 4.87033, 5.40138}, {1.66172, 6.00282,        5.1889}, {0.0873425, 5.97487, 6.85352}, {-0.0873903, 5.21734,        6.30516}, {2.00121, 5.14253, 5.51722}, {4.29976, 5.27308,        5.64666}, {0.988506, 6.73676, 6.59325}, {2.25374, 5.26316,        7.00213}, {3.74567, 6.67823, 6.34782}, {4.79574, 5.92614,        6.35025}, {3.28421, 6.66997, 4.2437}, {3.88385, 5.62567,        6.89584}, {3.46529, 5.45601, 4.13669}, {5.23652, 4.7538,        4.97666}, {5.72676, 5.96949, 4.96138}, {5.58535, 5.25335, 5.92877}}      `coord` contains the `{x, y, z}` coordinates of 256 particles.               Distance[x_, y_, z_] :=  If[# < z/2, #, Sequence @@ {}] & @                       Sqrt[Total[((x - y) - z*Round[(x - y)/z])^2]]      Distance computes the periodic distance between two particles and only returns it if it meets a criterion.


title: Type conversion: LibraryLink mint vs. MathLink integer type

text: Assume the following situation: I have a _WolframLibrary_ function which gets as parameter an integer tensor (which is for simplicity of rank 1) and the function should return an integer list through _MathLink_. My question is about the used types in this function only. The start of such a function could look like the following, where I use _WolframLibrary_ functions declared in `WolframLibrary.h`               EXTERN_C DLLEXPORT mint func( WolframLibraryData lib, mint argc,                                    MArgument *args, MArgument return_value)     {       MTensor tensor_u0 = MArgument_getMTensor(args[0]);       mint *u0 = lib->MTensor_getIntegerData(tensor_u0);           // ...     }      The full declaration of the last function is               mint* (*MTensor_getIntegerData)( MTensor);      The array `u0` contains the linear data of our tensor. Let's say I worked with this array, I used consistently `mint` in all procedures and I want to send now the `mint *result` array back through _MathLink_. In the _MathLink_ API we have several functions for sending integer lists               int MLPutInteger16List(MLINK link, short *a,int n)     int MLPutInteger32List(MLINK link, int *a,int n)     int MLPutInteger64List(MLINK link, mlint64 *a, int n)      Usually you just use `MLPutIntegerList` which uses the integer type of the machine. Unfortunately, since version 9 the _MathLink_ integer type and the _WolframLibrary_ integer type differ on my machine. Additionally, the types used in _MathLink_ seem to be completely unrelated to the _WolframLibrary_ types. While I can use the types in a pure _WolframLibrary_ function consistently and hopefully portable, mixing those two technologies seems not possible easily. What I would have to do is to look up the underlying type of `mint`, which is `long` on my machine here, but `int` on the Windows machine of my colleague and probably `long long` on our Windows 7 64bit box. After that I can select the appropriate `MLPut...` function for my special system. This is not portable and I basically have to repeat all system-dependent `#ifdef`s which are already there in `mathlink.h` and friends. **Question:** What am I missing here? There must be a portable and consistent way to cast both types.


title: Importing data sets from plain-text files and performing operations on them

text: I am working with a lot of daily weather files in the `txt` format. I need to calculate a daily quantity from each of them, e.g., daily light intensity, which involves a simple summation of the light intensity column in Excel. As I am working with over three years of data, it is not possible to do this manually. How can I automate this in _Mathematica_? Currently I import all the files using the following method. (Example shown is for Jan 1 to Jan 31)               filenames = FileNames[];       TestList = Flatten[Table[Files[[j, i]], {j, 1, 31}, {i, 2, 1437}], 1];       LightIntensity = TestList[[1 ;;, 5]];       DailyLightIntensity = Partition[LightIntensity, 1436];       DailySummation = Table[Total[DailyLightIntensity[[i]]],  {i, 1, 31}]      The method above only works assuming all the `txt` files contain rows from 2 to 1436, so I can use `Partition`, but I also need to handle cases with missing data. I want to automate this process with _Mathematica_ , import each `txt` file separately, perform the necessary calculations, and store the answer. How can this be done? The naming convention of the txt is given below: > [112] 2012-01-01   >  [112] 2012-01-02   >  [112] 2012-01-03   >  [112] 2012-01-04   >  ...   >  [112] 2012-12-31


title: Irregular Confluent Hypergeometric Functions (Spherical Coulomb Wavefunctions)

text: I want to program in the regular and irregular spherical Coulomb wavefunctions $F_\ell(\gamma,kr)$ and $G_\ell(\gamma,kr)$, respectively, which are defined in terms of the regular and irregular solutions to Kummer's differential equation $$\Big[z\frac{d^2}{dz^2}+(\beta-z)\frac{d}{dz}-\alpha\Big]\,f(z)=0\,.$$ The **regular solution** is given by the standard Confluent hypergeometric function ${}_1F_1(\alpha|\,\beta|\,z)$. I can access this function in _Mathematica_ using `Hypergeometric1F1`, out of which I can construct the regular spherical Coulomb wavefunction $F_\ell(\gamma,kr)$. But I am unable to find the two **irregular solutions** , typically denoted $W_1$ and $W_2$. I need these to construct the irregular spherical Coulomb wavefunction. The $W$'s and the regular ${}_1F_1$ are connected by the relations: $${}_1F_1(\alpha|\,\beta|\,z)=W_1(\alpha|\,\beta|\,z)+W_2(\alpha|\,\beta|\,z)$$ Does anyone know how I can access **both** irregular solutions?


title: Need help solving a system of two 1st order nonlinear differential equations

text: The original system of equations reads: $\begin{cases} f'(r) + f(r) \left(a(r) - \frac{1}{r}\right) = 0,\\ f^2(r) + a'(r) + \frac{a(r)}{r} - 1 = 0\,, \end{cases}$ with boundary conditions $f(0) = 0\,,\,\, f(\infty) = 1\,.$ I know that it allows non-divergent nontrivial solutions $\left(0 \leq f(r) \leq 1\,,\,\, f(r \to 0) \sim r\right.,$ and approaching exponentially to $1$ at large $r$$\left. \right)$. Due to the boundary condition at infinity I tried the following change of variables: $r = \frac{1}{x} - 1$, which transforms it to the following system: $\begin{cases} -x^2 f'(x) + f(x) \left(a(x) - \frac{x}{1 - x}\right) = 0,\\ f^2(x) - x^2 a'(x) + a(x) \frac{x}{1 - x} - 1 = 0\,, \end{cases}$ with boundary conditions $f(0) = 1\,,\,\, f(1) = 0\,,$ which Matematica (NDSolve) can't solve:               NDSolve[{-x^2 f'[x] + f[x] (a[x] - x/(1 - x)) == 0, f[x]^2 - x^2 a'[x] + a[x] x/(1 - x) == 1,             f[0] == 1, f[1] == 0}, {f,a}, {x, 0, 1}]      One can eliminate $a(x)$ to obtain a 2nd-order differential equation for $f(x)$: $f^2(x) + x^4\left( \frac{f'(x)}{f(x)}\right)^2 - x^4 \frac{f''(x)}{f(x)} +x^3\left( \frac{1}{1 - x} - 2\right)\frac{f'(x)}{f(x)} - 1 = 0\,,$ for which NDSolve again has no answer:               NDSolve[{f[x]^2 + x^4 (f'[x]/f[x])^2 - x^4 f''[x]/f[x] + x^3 (1/(1 - x) - 2) f'[x]/f[x] - 1 == 0,           f[0] == 1, f[1] == 0}, f, {r, 0, 1}]      Any suggestions how to solve this problem in Mathematica (and not Matlab)?


title: Sequence of binary trees with different source nodes and with the same Strahler hierarchical order

text: I would like to create a picture which contains a sequence of binary trees with the same Strahler hierarchical order (for example equal to 2) e with a sequence of different source nodes "i" (from 1 to 7 for example). Thank you all for the help!![enter image description here](http://i.stack.imgur.com/3MZ2j.jpg)


title: Numerical Error with Large Matrices

text: I am writing a Finite Element Analysis program in Mathematica. The code involves handling a large matrix with large entries. I get an error when I try to use Mathematica's "LinearSolve" to solve a problem that requires numbers larger than approximately 1e7 in the matrix; the error states that I have a "badly conditioned matrix". As a test, I generated an arbitrarily sized lower triangular matrix with random entries between a prescribed min and max value. Then I form an invertible matrix by multiplying the lower triangular matrix by its transpose (it can be shown that a lower triangular matrix multiplied by its transpose is invertible). Then, I multiply the newly formed matrix by its inverse. The result should be the identity matrix. Just as I suspected, when the matrix is either large or contains large entries (i.e. 50x50 with numbers between 1e7 and 1e8), I get the "badly conditioned matrix", and "may contain numerical errors" warnings. Here is the code:               ClearAll["Global`*"];     size = 50;     min = 10*^7;     max = 10*^8;     ltm = Array[0 &, {size, size}];     matrix = Array[0 &, {size, size}];     For[i = 1, i <= size, i++,         For[j = 1, j <= i, j++,             ltm[[i, j]] = RandomReal[{min, max}];         ]     ]     matrix = ltm.Transpose[ltm];     inv = Inverse[matrix];     Print[matrix.inv // MatrixForm];      I can fix the error by forcing the random entries to have a set precision of 30:               ClearAll["Global`*"];     size = 50;     min = 10*^7;     max = 10*^8;     ltm = Array[0 &, {size, size}];     matrix = Array[0 &, {size, size}];     For[i = 1, i <= size, i++,         For[j = 1, j <= i, j++,             ltm[[i, j]] = SetPrecision[RandomReal[{min, max}],30];         ]     ]     matrix = ltm.Transpose[ltm];     inv = Inverse[matrix];     Print[matrix.inv // MatrixForm];      The problem is that there is no easy place in my actual program to use the SetPrecision[] command. I tried to use               $MinPrecision=30;      at the top of the sample code, but it does not work. Any thoughts?


title: Why is Flattening a CoefficientArray so slow?

text: I have a vector of $n$ degree $n$ polynomials in $(x,y,z)$, each of whose coefficients is an inhomogenous linear expression in $3 n^2$ variables. I want to write down the linear equations in these $3 n^2$ variables which say that all these coefficients are identically zero. Here $n$ is about $15$. I used to be doing this with a combination of various `Map[]`, `Coefficient[]` and `CoefficientList[]` commands, but the result was much slower than I wanted. Tonight, I discovered the `CoefficientArrays[]` command in the documentation, which seemed built for exactly this job. To my surprise, I found that replacing one of my `Coefficient[]` calls with `CoefficientArray[]` was a dramatic improvement, but replacing the other `CoefficientList[]` was a disaster. Of course, I know what to do: Replace the good one but not the bad one! But I am curious why. The following code sets up test data. In the actual use, `f` and `PolyBasis` are not random polynomials but part of a larger computation, but I found that I could use random data for profiling without changing the speed:               n = 15;          f = Sum[Random[] x^i y^j z^(n - i - j), {i, 0, n}, {j, 0, n - i}];     PolyBasis = Table[Sum[Random[] x^i y^j z^(n-1 - i - j), {i, 0, n-1}, {j, 0,          n-1 - i}], {n}];          AA = Table[a[i, j], {i, 1, n}, {j, 1, n}];     BB = Table[b[i, j], {i, 1, n}, {j, 1, n}];     CC = Table[c[i, j], {i, 1, n}, {j, 1, n}];          MM = x AA + y BB + z CC;          LeftKer = MM.PolyBasis - Prepend[ConstantArray[0, n - 1], f];      Here is what I used to be doing:               AbsoluteTiming[EqL = Flatten[Map[CoefficientList[#, {x, y, z}] &, LeftKer]];]        (* {0.562461, Null} Kind of slow. *)          shortEqL = Select[EqL, ! (# === 0) &];           vars = Flatten[Join[       Table[a[i, j], {i, 1, n}, {j, 1, n}],       Table[b[i, j], {i, 1, n}, {j, 1, n}],       Table[c[i, j], {i, 1, n}, {j, 1, n}]]];          AbsoluteTiming[Big = Map[Coefficient[#, vars] &, shortEqL];]       (* {20.197230, Null} REALLY SLOW *)          AbsoluteTiming[small = shortEqL /. Map[(# -> 0) &, vars];]       (* {3.257321, Null} Significantly slow *)      Replacing the last two commands with `CoefficientArrays[]` is a huge gain:               AbsoluteTiming[{small2, Big2} = CoefficientArrays[shortEqL, vars];]       (* {0.105790, Null} Yippee! *)      Replacing the "kind of slow" command with CoefficientArrays gains a little:               AbsoluteTiming[EqL2=CoefficientArrays[LeftKer, {x, y, z}];]       (* {0.401718, Null} *)      But `Flatten[EqL2]` runs for many minutes without stopping, as does `Normal[EqL2]`! **Question:** Why is `Flatten[]`ing the output of `CoefficientArrays[]` so bad? And is there something smart I should be doing to improve on `EqL = Flatten[Map[CoefficientList[#, {x, y, z}] &, LeftKer]];`? For the curious, we are trying to remove some of the bottlenecks in the algorithm described here.


title: Get information about a stack of images, without plotting it

text: A very long time ago I used _Mathematica_ for a few months and found it very intuitive. Now for my work I use _MatLab_. I was just trying some stuff out with _Mathematica_ again and there is something I cannot quite get the hang of. I import a stack of images. Then I want to know the dimensions of my stack, but when I use `Length` or `Dimensions`, it only lists the number of images. Also when I use `?` it not only shows me information, but it also plots every single "image" in it, which takes very long. My question here is how to get the image size(s) for the imported stack of images?


title: Adding elements in the sublists

text: How can I add the elements in the sublists?   For example, if I have the list which is                m={{1,3},{2,3},{4,1}}      then, the output that I want is `3+3+1=10`. How can I do this?


title: Help me understand what Map[Max[#] - Min[#] &, ttt, {2}] does

text: ttt =        Table[(z /. FindRoot[eqn1[x, z, y], {z, z0}]),          {x, 2.5*10^9, 3.5*10^9, 10^8/5},          {y, 0.6 10^-15, 1.4 10^-15, 10^-16},          {z0, 0.100, 0.110, 0.005} ];          MatrixForm[ttttt = Map[Max[#] - Min[#] &, ttt, {2}]];          ListPlot[Transpose[ttttt], Joined -> True, PlotMarkers -> Automatic, PlotRange -> All];      I know what `FindRoot` does, it finds the roots of `z` of `eqn1[x, z, y] == 0`, and `z0` is the initial value where `FindRoot` searches for a root. So the first expression simply finds roots of `z` about 0.1, 0.11, 0.005 while iterating `x` and `y`. I'm puzzled by the second expression, the one involving `Map[Max[#] - Min[#] &, ttt, {2}]`. I think it searches for the maximum and subtracts the minimum? Does it pick from a single root near one value of `z0` or for all three simultaneously?


title: Find roots of polynomial in field extension $GF(2^n)$?

text: How can I find roots of polynomial in extension field $GF(2^n)$?


title: Plotting an inequality with "plot" axis

text: Whenever I try to plot an inequality with "RegionPlot", all my plots come out in boxed frames. Is there a way to plot inequalities where I get my standard x and y axes crossing each other? For example, I am trying to plot $$x^2 - y^2 \leq 1$$ and Mathematica gives me with RegionPlot ![enter image description here](http://i.stack.imgur.com/zreir.jpg) See how my x and y axes are stuck to the left of the box instead of having them cross at the origin? Anyway around this?


title: Plotting discrete points on a phase plot

text: I'm trying to generate a phase plot of a sinusoidal voltage at discrete points using the following code:               ListPlot[Table[{5*Sin[n*π/4 + π/3], 5*Cos[n*π/4 + π/3]}, {n, 8}],              AspectRatio -> 1, AxesLabel -> {"Real", "Imaginary"}, PlotLabel -> "Plot 1d"]      I would also like to make it so there is an arrow that originates at the origin and ends at each point on the plane. Also, I would like to label each point with its corresponding value of n. Is this possible? How can I do it?


title: Set Global Maximum Precision

text: I'm sure this has been asked before, but I've looked around and can't figure it out: How do I set a global maximum precision for a notebook (or in general, globally)? I have a large notebook in which I'm trying to get Mathematica to do all computations to a precision of 15 digits. The objective is to compare the results of the computation at the end with the default precision to the 15 I am enforcing. What are the options that I have to set at the beginning of the notebook to make this happen? Thanks!


title: ReadList and Import cannot read data separated by ","

text: I have a data file contains several lines of numbers that separated by "," and I cannot load it correctly with ReadList and Import. Here is a example: with data contains "," and "\n", simple `ReadList` doesn't work.               ReadList[StringToStream["1099.5,0,-166.79\n1098.4,0,-166.79\n"], Real]     (* {1099.5, $Failed} *)      If we use separators, it works, but if we group the types, it doesn't work.               ReadList[StringToStream["1099.5,0,-166.79\n1098.4,0,-166.79\n"], Real,       RecordSeparators -> {",", "\n"}]     (* {1099.5, 0., -166.79, 1098.4, 0., -166.79} *)          ReadList[StringToStream[       "1099.5,0,-166.79\n1098.4,0,-166.79\n"], {Real, Real, Real},       RecordSeparators -> {",", "\n"}]     (* {$Failed} *)      And `Import` cannot import correctly as it treats each line as a string.               Import[StringToStream["1099.5,0,-166.79\n1098.4,0,-166.79\n"], "Table"]     StringQ /@       Flatten@Import[        StringToStream["1099.5,0,-166.79\n1098.4,0,-166.79\n"], "Table"]     (*       {{"1099.5,0,-166.79"}, {"1098.4,0,-166.79"}}       {True, True}          *)      So why they are not working in these cases? And How to make `ReadList` and `Import` to work without using `Partition` etc. after the import? Version: 9.0 on Mac.


title: Combining Histogram and SmoothHistogram

text: How can we draw `Histogram` and `SmoothHistogram` together for two data sets?. I'd like to show the first data set using `Histogram`, and the second using `SmoothHistogram`.


title: Help with DeleteCases

text: Trying to delete small elements from a list with               copy = DeleteCases[copy, {y_} /; y <= 1500.0 ]       but it does not work.


title: How To interactively create a Polygon in a Graphic?

text: Background: suppose I start with the following (working) snippet.                Manipulate[Graphics[Line[{{0, 0}, p}], PlotRange -> 2], {{p, {1, 1}}, Locator}]      Ideally, I would like to be able to add points with their own locator to the graphic and via selecting or otherwise add Polygons, Circles, BezierCurves, etc. Question: How can I interactively add a point to a Graphic that can be moved via its own locator? How can I select three or more points on such a Graphic and create a Polygon from them? ( I need the coordinates from the points, and which geometries have been created for later usage. ) *** UPDATE*** Thanks to FJRA's answer ( LocatorAutoCreate ) I can now rephrase the question as follows. From the following snippet                Manipulate[       Graphics[Map[Point[#] &, pts],         PlotRange -> 1], {{pts, {{0, 0}, {.5, 0}, {0, .5}}}, Locator,         LocatorAutoCreate -> True}]      **Question: How can I select multiple points and create a polygon from them. Ideally, I would like to select a geometry: i.e. Circle, Polygon, BezierCurve.**


title: Spike train representation

text: I have a spike train. The data shows the time at which the neuron fired a spike. I want to plot them like this picture: ![enter image description here](http://i.stack.imgur.com/QJQvo.jpg) Here is the data for one spike train which corresponds to the one of the neurons in the figure above. Download the spike train data


title: Behavior of Inner depends on List dimensions?

text: Consider the following case:               list1 = {q, r, s};     list2 = {{a, 2}, {b, 3}, {c, 1, f}};     Inner[{#1, #2} &, list1, list2, List]     (* Out[] := {{q, {a, 2}}, {r, {b, 3}}, {s, {c, 1, f}}} *)      However, if the last element of `list2` has `Length` 2:               list1 = {q, r, s};     list2 = {{a, 2}, {b, 3}, {c, 1}};     Inner[{#1, #2} &, list1, list2, List]     (* Out[] := {{{q, a}, {r, b}, {s, c}}, {{q, 2}, {r, 3}, {s, 1}}} *)      I would have expected (and wanted) a result like:               (* Out[] := {{q, {a, 2}}, {r, {b, 3}}, {s, {c, 1}}} *)      So,   1. Why does this `Inner` operation change if the `list2` entries are all of the same length?    2. How can I generate an output like the expected result? * * * **Edit** I came up with a potential answer to question 2:               Partition[Riffle[list1, list2], 2]     Out[] := {{q, {a, 2}}, {r, {b, 3}}, {s, {c, 1}}}      but this seems somehow too-complicated.


title: Replace expression using a tuple

text: Given an expression in `x`, `y`, `z` (for example), and a list with three elements, like `{1,2,3}`, how can I do the equivalent of `expr/.{x->1,y->2,z->3}`? So for example suppose               a = {1,2,3}     x^2+y^2+z^2 /.{x->1,y->2,z->3}      but obviously `x^2+y^2+z^2/.{x,y,z}->a` does not work.


title: How to plot and solve the numerical solution of a integro-differential equation

text: I have a integro-differential equation of the form $y'(t) = - \int_0^t {y(t_1 )} e^{t_1 - t} dt_1, {\rm{ t}} \in {\rm{[0,10], y(0) = 1}}$ My code is:               f[t_Real] := NIntegrate[y[t1]*Exp[t1-t]], {t1, 0, t}];          solution1=NDSolve[{D[y[t], t]==-f[t], y[0] == 1}, y[t], {t, 0, 10}];          Plot[Evaluate[y[t] /. solution1], {t, 0, 10}, PlotRange -> All].      But this simply outputs the error: > NIntegrate::nlim: t1 = t is not a valid limit of integration.


title: A simple StringCases problem

text: Given this text:               text1 = "  A  Vitamin D Deficiency (ICD-9-CM 268.9) (ICD-9-CM 268.9) 09/11/2015  01 ";      Yes, the ICD code values are duplicates- possibly but not certainly in all the records. What string expression will match only the code values - twice if duplicated? I've tried:               StringCases[text1, "(ICD-9-CM " ~~ code__ ~~ ")" .. :> code,       Overlaps -> False]          (* {"268.9) (ICD-9-CM 268.9"} *)          StringCases[text1, "(ICD-9-CM " ~~ code__ ~~ ")" .. :> code,   Overlaps -> True]          (* {"268.9) (ICD-9-CM 268.9", "268.9"} *)          StringCases[text1, "(ICD-9-CM " ~~ code__ ~~ ")" .. :> code,       Overlaps -> All]          (* {"268.9) (ICD-9-CM 268.9", "268.9", "268.9"} *)      Removing the `..` repeat pattern doesn't alter the outputs. What's the explanation for this behavior?


title: How to draw a contour diagram in Mathematica?

text: This answer at Math.SE contains a neat contour diagram created using Mathematica: ![](http://i.stack.imgur.com/Jb3i2.png) What Mathematica functions I can use to draw diagrams like this?


title: How can I use a For loop in a recursive function?

text: I am creating a simple radix2 FFT algorithm (based on Cooley-Turkey) by using a recursive function to obtain the fft. The function is supposed to work on a list (assuming the length is a power of two). and it's supposed to give back a list of the same size. The code I wrote gives back a single output. It looks like the For loop is not working. Would anybody know why the For loop is not working? ![enter image description here](http://i.stack.imgur.com/EQ1hb.jpg)               Clear[fft2]     fft2[L_] :=       fft2[L] = Module[{Le, Lo, n, w, k}, (*Rememeber previous step*)        n = Length[L];        If[n == 1, (*Tests if N=1 and assigns that value if true*)           L,           Le = Take[L, {1, -1, 2}]; (*Creates a new list of size N/2 with even indexed elements*)           Lo = Take[L, {2, -1, 2}]; (*Creates a new list of size N/2 with odd indexed elements*)          For[k = 0, k < n, k++, (*Combines terms*)              w = Exp[-2 Pi I *k/n];              Xk = fft2[Le] + w*fft2[Lo];              Return[Xk]             ]           ]        ]


title: Changing FrameTicks of ListPlot

text: I am unable to change the frameticks for my list plot. I am trying to plot a growth rate `omega` function which looks like this:               Clear[\[Omega]3, \[Omega], \[Epsilon], h, K1, \[Delta], q, Bi, m]     \[Omega]3 = \[Epsilon]/((h + K1)^2) - h^3 q^4 - Bo h^2 q^2 +        m q^2 h^2/((h + K1)^2) + \[Delta] h^3 q^2/((Bi h + K1)^3)     \[Omega] = \[Omega]3 /. {\[Epsilon] -> 6.01*10^-8, \[Delta] ->          5.19*10^-7, K1 -> 1, Bi -> 1, m -> 0.1092, Bo -> 0}      I vary the `q` via a table and capture the film thickness for `omega=0` for               ListPlot[      Table[       q = qx;       2.35 FindRoot[\[Omega] == 0, {h, 1}][[1]][[2]],       {qx, 0.1, 2, 0.1}       ],      PlotRange -> {{0, 21}, {0.0, 4}},      AxesLabel -> {"wavenumber", "Growth rate"},      BaseStyle -> {FontSize -> 18},      Frame -> {True, True, False, False},      FrameLabel -> {"Wavenumber, q",         "\!\(\*SubscriptBox[\(h\), \(\[Omega] = 0\)]\)[mm]"},      PlotStyle -> Directive[Thick, Black, PointSize[Large]]      ]      The plot looks like this: ![enter image description here](http://i.stack.imgur.com/naChp.png) The **x axis** has grid points and not the values of `q`. Is there any way I could have `q` values instead of grid points?


title: How to add more than one label to Histogram automatically

text: I have a huge data and I want to add two labels to the Histogram. the problem here is that the labels are calculated and added automatically to the histogram. for example if I have the following Histogram:               Histogram[RandomVariate[NormalDistribution[0, 10], 20000], 20,       LabelingFunction -> (Placed[Rotate[Style[#1, Bold, 14], 90 Degree],           Above] &),       ColorFunction -> Function[{height}, ColorData["Rainbow"][height]]]      ![enter image description here](http://i.stack.imgur.com/FkWtW.jpg) In this Histogram, the Bars labels are calculated automatically. I want to add the percentage of each number at the top of the number. something like the following handmade Histogram : ![enter image description here](http://i.stack.imgur.com/6szrp.jpg)


title: Generating stripes on a polygon

text: I want to create a `Graphics3D` polygon that has stripes on it. My code is                Graphics3D[{        LightBlue,         Polygon[{{0, 0, 0}, {0, 2, 0}, {1, 2, 0}, {1, 0, 0}}]},         Boxed -> False,        Lighting -> {{"Ambient", LightBlue}},        ViewPoint -> {0.2, 0, 0.2},         RotationAction -> "Clip"]      I want horizontal equidistant stripes on it. Can anyone help?


title: How minimize a function involving abs $(|\ldots|)$?

text: I am trying to decide the best way to solve this: > Minimise $Y = | K + ax^2 + bxy + cy^2 |$, with decision variables $x$ and $y$ and $a > 0$. I also have a number of convex and affine constraints I won't bother listing to do with the ratio of $x$ to $y$. My problem is the absolute value operation in the objective function. If it wasn't there, this would (to me) appear to be a simple quadratic program, as the objective function would be convex. But no matter how I carve it up, (e.g., I've thought about substitute variables, doing it in two stages, etc.), but I always end up with a concave part of the problem that (I presume) standard QP software won't like. (can't seem to add a comment so have to place edit here): Thanks for advice but is Minimise in this situation p-time efficient? I don't want to use a non- linear optimiser - I'd much prefer to map it to a nice convex (hopefully quadratic-convex) problem if possible. My real problem has x1 to xn with non- sparse A matrix. I have been looking into second-order cone but haven't got very far on that track. (second edit). Thanks again guys for additional comments. Rahul I guess that is fair enough; I think given that insight my question basically becomes "what is the most elegant way of solving this" rather than "help me force this to be convex". Sjoerd thankyou - if I read you right you are proposing to minimise Y^2 = px^4 + qx^3y + rx^2y^2 + sxy^3 + ty^4 + c. Can you elaborate on how the minimisation is better behaved? I seem to recall polynomial techniques are available but not sure where to start; I presume the mission is - assuming p is positive - to evaluate Y^2 at all the places where the first deriv of Y^2 is zero? And that means the problem then reduces to locating all of those points (not straight forward I imagine in n dimensions?).


title: Comparing data sets with fade transitions (Code speed-up)

text: I am using the utility below for data comparison. However, with my real (more complex) charts the processing is quite slow, so setting the `Pause` time under `0.01` does not speed up the transition effect. Quite a few frames are needed for a smooth transition. I wonder if anyone can suggest ways to speed things up.               p1 = {{0.98, 1.02}, {1.29, 1.46}, {1.45, 1.8}, {1.69, 1.83},        {2.01, 2.43}, {2.07, 2.43}, {2.39, 2.5}, {2.71, 2.99},        {3.03, 3.51}, {3.33, 3.54}, {3.9, 3.91}, {4.2, 4.36},        {4.46, 4.88}, {5.14, 4.62}, {5.48, 5.29}, {5.95, 5.96}};          p2 = {{1.04, 1.17}, {1.31, 1.61}, {1.51, 2.13}, {1.71, 2.06},        {2.03, 2.61}, {2.15, 2.65}, {2.43, 2.65}, {2.61, 3.13},        {2.95, 3.69}, {3.31, 3.84}, {3.92, 4.29}, {4.16, 4.69},        {4.6, 5.14}, {5.14, 5.21}, {5.6, 5.66}, {5.99, 6.33}};          Deploy@Panel@DynamicModule[{op = 0, now = 0,         a = ListPlot[p1, PlotRange -> {{0, 7}, {0, 7}},           PlotStyle -> Directive[PointSize[0.02], Purple]],         b = ListPlot[p2, PlotRange -> {{0, 7}, {0, 7}},           PlotStyle -> Directive[PointSize[0.02], Blue]]},             id = ImageDimensions@a;        frames = 40;             Column[{Row[{"Displayed data set:  ",            Button["  p1  ", If[op == 1, now = 0;              Do[op = Round[op - 1/frames, 0.001];               FinishDynamic[]; Pause[0.01], {frames}]],             Appearance -> Dynamic@If[op < 1 && now == 0, "Pressed", Automatic],             ImageSize -> Medium],                 Button["  p2  ", If[op == 0, now = 1;              Do[op = Round[op + 1/frames, 0.001];               FinishDynamic[]; Pause[0.01], {frames}]],             Appearance -> Dynamic@If[op > 0 && now == 1, "Pressed", Automatic],             ImageSize -> Medium]}],               Panel[Graphics[{White, Rectangle[{0, 0}, id],             Inset[Dynamic@Insert[a, Opacity[Abs[op - 1]], {1, 1}], Center, Center, id],             Inset[Dynamic@Insert[b, Opacity[op], {1, 1}], Center, Center, id]},            PlotRange -> {{0, First@id}, {0, Last@id}}, ImageSize -> id],           FrameMargins -> 15, Background -> White]}]]      ![enter image description here](http://i.stack.imgur.com/Exzue.png)


title: Importing data from excel and assigning a variable to each of its columns

text: How should I assign variables to the data imported from excel containing 3 columns which are time, mean and standard deviation. I want to perform operations on the three variables to get new variables. The excel file can be found on the link: https://drive.google.com/file/d/0B26xdKbTd58_SVRlOEdNaVV4VGM/edit?usp=sharing


title: Automatically highlight certain cells

text: I am looking for a method to highlight certain cells in a table/Grid based on meeting some user defined conditions. As an example:               M = {{-0.6, 0.04, 22}, {0.1, 0.3, 1}, {0.4, 0.05,0.01}}; (*can be much larger *)      As purely an example, the data could be formatted as:                TableForm[M, TableHeadings -> {{"x", "y", "z"}, {“correlation", "pValue",      “tStatistic"}}]  (*number of rows and columns can be very different *)      ![sample data](http://i.stack.imgur.com/PAi0k.png) I’d like to automatically highlight data which meets a certain user defined criteria say:               Abs@Correlation > 0.5 && Abs@pValue ≤ 0.05       So the highlighted table would look like: ![enter image description here](http://i.stack.imgur.com/66JAw.png) Ideally, I’d like a function that I can apply to a Table/Grid….


title: How can I avoid getting the error message Goto::nolabel in my code?

text: If anyone could suggest a reason why `Label[begin] ... Goto[begin]` would return `Hold[Goto[Begin]]`, and (better) how can I avoid this problem, I'd appreciate it. I suspect this is an outmoded control structure for simple programs, but I like it. I had an earlier version of _Mathematica_ and it was fickle. Sometimes adjusting the spacing cured the problem. The newer version is less forgiving, if it is user error. Edit: a silly example maybe but it gives the error message.               p[1] = .9; i = 1; Label[begin];     i++;     p[i] = p[i - 1] + 1;     Print[i];     If[i < 5, Goto[begin], Goto[end]];     Label[end];      > >     2 >   > > Goto::nolabel: Label begin not found. >> >   >   >     Hold[Goto[begin]] >


title: Limit as n -> ∞ for RSolve with Multivariate Recurrence Relation

text: I'm trying to solve the following when `n -> ∞`:               RSolve[{        a[n + 1] == a[n] + x (1 - a[n] - b[n]),        b[n + 1] == b[n] + y (1 - a[n] - b[n]),        a[0] == 0, b[0] == 0},        {a[n], b[n]}, n]      After a FullSimplify, I get the following for `a[n]` (and similarly for `b[n]`): ![http://i.imgur.com/gIGir7a.png](http://i.stack.imgur.com/gU4Kd.png) It's clear that as `n` gets larger that this expression converges so long as `0 < x < 1` and `0 < y < 1`, but simply plugging in `n = ∞` I get "Sum does not converge" as an error. For instance when I set `n = 20` and `x = 1/3` and `y = 1/4` I get the following:               547679985297149068793/     958439998111868780544      For `n = 50`:               130006259285744996749134383652034872751260675268341857/     227510953750053744333189631883564158123178815081414656      In floating point notation these both are ~0.571429, which is approximately 4/7 (thanks @hftf), suggesting the answer is `(1/y)(1/x + 1/y)`. How does one get RSolve to return this result?


title: Can I define new graphics directives?

text: Is it possible to define new graphics directives? For example, suppose I want to be able to use the following code:               Graphics[{ BigPointSize[0.07], SmallPointSize[0.04],                Red, BigPoint[{1,1}], BigPoint[{1,3}], SmallPoint[{3,1}],                Blue, SmallPoint[{2,2}], SmallPoint[{3,2}], BigPoint[{0,0}]             }]      Is there any way to define `BigPointSize`, `SmallPointSize`, `BigPoint`, and `SmallPoint` so that this code will work as intended? Ideally `BigPointSize` and `SmallPointSize` should have all of the functionality of other graphics directives, e.g. scoping inside of lists, and the ability to call the command multiple times within the same list. (Obviously it's possible to draw these points in other ways, but I'm curious whether it's possible to get this _syntax_ to work.) **Edit:** Just to clarify, I would like `BigPointSize` and `SmallPointSize` to work the same way as PointSize and other graphics directives. For example, the code               Graphics[{ BigPointSize[0.1],                { BigPointSize[0.05], BigPoint[{0,0}] },                BigPoint[{1,0}]             }]      should produce one point of size `0.05` and one point of size `0.1`.


title: Restrictions problem

text: I tried to program a simple linear optimization model and don't know where my mistake lies. The function should be a sum over "t" and "z" from the product of two constants ("e" and "H") and the decision variable "X". The first constraint should say that every decision variable "X" (for all "t" and "z") can only take the value 0 or 1. The second constraint should say that every decision variable "X" (for all "t") can only select one option z. Therefore the sum of all "X" over "z" (for all "t") has to be equaling 1. The third constraint should say the same as the second only the other way around.               NMinimize[{Sum[        Subscript[e, t]*Subscript[H, z]*Subscript[X, t, z] , {t, 1,          34}, {z, 1, 34}u],        ForAll[{t, z}, Subscript[X, t, z] \[Element] Integers,          0 <= Subscript[X, t, z] <= 1] &&         ForAll[t, Sum[Subscript[X, t, z], {z, 1, 34}] == 1, {t, 1, 34} ] &&         ForAll[z,          Sum[Subscript[X, t, z], {t, 1, 34}] == 1, {z, 1,           34}]}, {Subscript[X, t, z]}]


title: How to simplify to form without imaginary unit

text: I have an integral that I compute with Mathematica and as a result I get a seemingly complex expression (i.e. the expression contains the imaginary unit, $i$, at some places). However, if I try to numerically compute the values of this expression at some values of my variables, I notice that in fact the value of the result is always real (for real values of variables); the imaginary parts cancel out in a right way to make the result real. This is also evident from the fact that the expression is a solution to a physical problem that is supposed to give a real solution. How do I make Mathematica simplify the expression so that it doesn't contain any imaginary units anymore? Edit: The expression I'm trying to simplify is: $$\frac{\sqrt{1-\frac{2}{-i x+y+1}}}{x+i (y-1)}+\frac{\sqrt{1-\frac{2}{i x+y+1}}}{x-i (y-1)}$$ In Mathematica form:               Sqrt[1 - 2/(1 - I x + y)]/(x + I (-1 + y)) + Sqrt[1 - 2/(1 + I x + y)]/(x - I (-1 + y))


title: Extract differential operator from differential form

text: Let's say I have :               a*u''[x]+b*u'[x]       where `a` and `b` are constant I would need to get > >     (a*d2/dx2 + b*d/dx)u[x] >   Can anyone tell me how I could to proceed?


title: Recursion and safety of SetAttributes[Function, SequenceHold]

text: Compare the timings below               N@Timing@Block[        {iii = 0},        Nest[         {#[[1]] + 1, Plus[#[[1]], 1, (#[[1]] + 1)*#[[2]]]} &         ,         {0, 1},         5000         ]        ]      -> {0.043021, {5000., 1.572304446472042*10^16326}}               SetAttributes[Function, SequenceHold]     N@Timing[#2 &@        Nest[         Sequence[#1 + 1, Plus[#1, 1, (#1 + 1)*#2]] &         ,         Unevaluated[Sequence[0, 1]],         5000         ]            ]     ClearAttributes[Function, SequenceHold]      -> {0.030972, 1.572304446472042*10^16326} Now, this may be a silly example for the use of Nest, as we do not exploit the fact that "the first argument" will always be an Integer (see further below to see that Do is faster). But I guess there can be more complex cases where the use of the form/idiom `Nest[Function[Sequence[expr]],args]` where Function has SequenceHold can improve the speed of computation. I know that the general answer to questions of this type is: "It is not safe to Clear/add Attributes to system functions". But apparently it is useful to be able to let Function return a Sequence. Note that we can also do               N@Timing[#2 &@        Nest[         Identity[Unevaluated[Sequence[#1 + 1, Plus[#1, 1, (#1 + 1)*#2]]]] &         ,         Unevaluated[Sequence[0, 1]],         5000         ]            ]      -> {0.03492, 1.572304446472042*10^16326} where we let Function return a Sequence in a more stabile/approved/classical manner. See my answer here for more ways of returning a Sequence "on the fly". But these additional functions/heads seems to slow things down. The question is: Is there a context in which it is safe to use Function with SequenceHold? For example in the "context"               Nest[Function[Sequence[body]],Unevaluated[Sequence[startSequenceBody]], n]      Where body contains only "simple" functions like Times Plus and Power startSequenceBody is just some reals or integers seperated by commas n is just an integer Also, an answer of the form: "This is not necessary, the following is an alternative" is of course appreciated. **Remarks** Functional programmers may want to close their eyes and scroll down, but I don't want to discriminate ;). We have               N@Timing@Block[        {arg = 1},        Do[         arg = Plus[iii, 1, (iii + 1)*arg]         ,         {iii, 0, 4999}         ];        arg        ]      -> {0.02014, 1.572304446472042*10^16326} Which is the fastest thing I could come up with. Here is also an approach I like to call the Mr.Wizard style of doing things (because of this answer by him). Let me compare it with an approach using ReplaceRepeated while I am at it. We have               ClearAll[ggg2]     ggg2[nnn_, total_] := ggg2[nnn + 1, Plus[nnn + 1, (nnn + 1)*total]];     ggg2[5000, total_] := total;          Block[{$IterationLimit = 30000, a, b},       a = Timing@        ReplaceRepeated[{0,           1}, {{5000, total_} :>            total, {nnn_, total_} :> {nnn + 1,             Plus[nnn, 1, (nnn + 1)*total]}}];      b = Timing@ggg2[0, 1];      {Last[a] == Last[b], First[a], First[b], N[Last[a]]}]      -> {True, 0.029197, 0.027240, 1.572304446472042*10^16326} **Background of the problem/further remarks** In my answer here, I should probably use something like "the Mr.Wizard approach" (letting evaluator be a function that calls itself), whereas I use ReplaceRepeated. Here it would be nice to be able to deduce cases in which one of the arguments of the recursive function is simply a "counter", so that we can use Do (instead of letting evaluator call itself") to speed things up (this also eliminates the need for a state boolean). In the answer I link to above, note that all the examples I give will be faster if we could clear the Attributes Orderless and Flat from Times and Plus. This increases my interest in the safety of changing Attributes. To learn more about this, we have this Q&A. Note that in my previously mentioned answer the idea is to exploit the strengths of Mathematica as a computer algebra system, being able to deal with expressions like a+(b*(c+notANumber) (ok, we have to use Expand, but still). Redefining (rules for) Times and Plus seems to contradict this. But maybe someday somebody will make a nice set of tools for such recursions. **Final remark** All the examples above can be considered an answer to the question: "What ideas can help with recursion when I know how many times I want to "iterate"?". Consider this if you feel the "background of the problem" section is a bit of a rant :).


title: Can Mathematica understand Excel dates when in number format?

text: I have a very large Excel file with dates in the format **2013/01/17 08:02:00 PM** which is a custom date format. I have to convert this file to CSV in order to import it into Mathematica because I can't get around the Java heap space error (I have tried the suggestions on this site). When I convert it to CSV the dates automatically change to the number format eg **40969.00069** which I think represents the number of days since 1900. This is a standard date format that is sometimes used in Excel and automatically used when I save the Excel file as a CSV. When I now import the CSV file into Mathematica the dates stay in this number format. How can I get Mathematica to understand these 'number formatted dates'? When I tried the following code, just trying to get a year from the number formatted date, Mathematica returned 1900 no matter what year in number format I apply it to. This tells me that Mathematica doesn't understand what these numbers are.               DateString[41291.88819, {"Year"}]      I have looked at the help files and searched on this site but I can't seem to solve this.


title: Struct equivalent in Mathematica?

text: I really miss having something like a `struct` in Mathematica. I know of (and regularly use) a couple of programming techniques which feel like a `struct` (e.g., using downvalues), but are ultimately unsatisfactory (perhaps I'm using downvalues incorrectly). What programming approaches are available which provide similar functionality to a `struct`? Here's an abbreviated (and hopefully not too obtuse) example of how I use downvalues to emulate a struct. In this case, I'm distinguishing between TLC and TEC (these are sets of parameters for two different phases of a Moon mission, trans-lunar cruise and trans-earth cruise):               deadBandWidth[X][TLC] ^= 10. \[Degree];     deadBandWidth[Y][TLC] ^= 10. \[Degree];     deadBandWidth[Z][TLC] ^= 20. \[Degree];     sunSearchAngle[Z][TLC] ^= 230. \[Degree];     sunSearchRate[Z][TLC] ^= 1. \[Degree]/Second;     sunSearchAngle[X][TLC] ^= 75. \[Degree];     sunSearchRate[X][TLC] ^= 1. \[Degree]/Second;     safingSpinRate[TLC] ^= (360. \[Degree])/Day;     sunVector[TLC] ^= {-Cos[45. \[Degree]], 0., Sin[45. \[Degree]]};     safingSpinAxis[TLC] ^= sunVector[TLC];          deadBandWidth[X][TEC] ^= 20. \[Degree];     deadBandWidth[Y][TEC] ^= 20. \[Degree];     deadBandWidth[Z][TEC] ^= 20. \[Degree];     sunSearchAngle[Z][TEC] ^= 230. \[Degree];     sunSearchRate[Z][TEC] ^= 1. \[Degree]/Second;     sunSearchAngle[X][TEC] ^= 75. \[Degree];     sunSearchRate[X][TEC] ^= 1. \[Degree]/Second;     safingSpinRate[TEC] ^= (360. \[Degree])/Hour;     sunVector[TEC] ^= {0., 0., +1.};     safingSpinAxis[TEC] ^= sunVector[TEC];          ?TLC     Global`TLC     safingSpinAxis[TLC]^={-0.707107,0.,0.707107}     safingSpinRate[TLC]^=6.28319/Day     sunVector[TLC]^={-0.707107,0.,0.707107}     deadBandWidth[X][TLC]^=0.174533     deadBandWidth[Y][TLC]^=0.174533     deadBandWidth[Z][TLC]^=0.349066     sunSearchAngle[X][TLC]^=1.309     sunSearchAngle[Z][TLC]^=4.01426     sunSearchRate[X][TLC]^=0.0174533/Second     sunSearchRate[Z][TLC]^=0.0174533/Second


title: Is there a function which instantly tells you whether an element is part of a list?

text: I have a very long list of numbers and I want to check whether there's a function (something that would look like `PartOfQ[element,list]`) that tells you immediately with a `True` or `False` as to whether the element in question is part of the list or not. Ideally it would also tell you its index. If there isn't a built-in such function, is there an efficient way of building such a function myself?


title: How to make Mathematica try harder to perform symbolic comparisons?

text: (I suspect this question is a duplicate, but I didn't find a sufficiently similar question with an answer to it.) I'm having trouble with comparisons of symbolic `Reals` that are equal, but which Mathematica has trouble recognising them as equal, apparently because it uses `N` to compare these (apparently after some simple symbolic manipulation). Typically these issues creep up in conditions like one (greatly simplified) below:               x > y /. {x -> Sqrt[(2 - Sqrt[3])^2 + (-3 + 2*Sqrt[3])^2], y -> 4 - 2*Sqrt[3]}      > N::meprec: "Internal precision limit $MaxExtraPrecision = 50.` reached while > evaluating -4+2\ Sqrt[3]+Sqrt[(2-Sqrt[3])^2+(-3+2 Sqrt[3])^2]." > > Sqrt[(2 - Sqrt[3])^2 + (-3 + 2*Sqrt[3])^2] > 4 - 2*Sqrt[3] This is in no way undocumented feature; it is discussed under Possible Issues section of `$MaxExtraPrecision`. What I really want is Mathematica to try a bit harder on solving these (in)equalities numerically in a block of code. How do I accomplish this? As a workaround for specific problem above, this does work (while `Simplify` on inequality part doesn't):               x > y /. Simplify @ {x -> Sqrt[(2 - Sqrt[3])^2 + (-3 + 2*Sqrt[3])^2], y -> 4 - 2*Sqrt[3]}      > False I would be happy to see a solution that could wrap up around a block of code, and which could possibly work also on non-algebraics that `FullSimplify` can handle. **EDIT:** To clarify my question: I want first example to evaluate like the expression below, and in general `Greater` to evaluate for `NumericQ` argument list similarly inside a code block where I want this feature to be used:                 Simplify[Sqrt[(2 - Sqrt[3])^2 + (-3 + 2*Sqrt[3])^2]] > Simplify[4 - 2*Sqrt[3]]      > False


title: Is there a way to parallelize the convolution component of EdgeDetect?

text: Provided an image like -               test = Import["http://upload.wikimedia.org/wikipedia/commons/d/d5/Sunflowers.jpg"]      We can run `EdgeDetect` (with the `"Canny"`, `"ShenCastan"`, `"Sobel"` options) to convolve a kernel of some form with an image to approximate first- order derivatives that indicate borders or significant and sudden variations in an image. I was wondering if there exists a mechanism for parallelizing `EdgeDetect` over multiple cores? Certainly it seems like this should be possible, since the "heavy lifting" computationally speaking is more or less just a convolution process? Perhaps we could decompose the input image into smaller chunks and then perform some fast "stitching" and post-processing operation? Update: Cormullion (in the comments) make the good point that one can decompose an image in as many fragments as you have cores using `ImagePartition`, run `EdgeDetect` on each fragment, then stitch the resultant `EdgeDetect` transformed image back together using `ImageAssemble`. I suppose one would use ParallelTable for this? The trouble, as cormullion notes, is dealing with the seams of the reconstituted / assembled image. I've also noted that ParallelTable doesn't really offer a great speedup, especially for smaller images (I use a larger image on purpose in the below example). Is there a better way of proceeding, or perhaps storing the image in memory? * * * Let's step through cormullion's suggestion for a cropped version of the above image. I have twelve cores, so I'm going to try to crop and chop the image up into twelve fragments, but it should be clear how to adjust this according to the number of cores on your machine. First, let's grab the image and crop it:               testImage = Import["http://upload.wikimedia.org/wikipedia/commons/d/d5/Sunflowers.jpg"]     testImage = ImageCrop[testImage, {2004, 2004}]      Our variable `test` is now a `{2004, 2004}` pixel crop of the original imported image. This lets us break it up into twelve `{501, 668}` pixel fragments. Remembering that the matrix will be $4 \times 3$, we can flatten the output of ImagePartition:               imageFragmentSet = Flatten[ImagePartition[testImage, {501, 668}]]      Now we can compare:               flattenedImageSet = ParallelTable[EdgeDetect[imageFragmentSet[[i]]], {i, 1, Length[imageFragmentSet]}] // AbsoluteTiming      With:               EdgeDetect[testImage] // AbsoluteTiming      The result is something like a $\approx 2$ to $\approx 3$ fold speedup. Can this be better optimized? We can now stitch the image together like so:               reconEDImage = ImageAssemble[Partition[flattenedImageSet, 4]]      Note that you need to put a `[[2]]` in front of `flattenedImageSet` if you neglect to remove the `// AbsoluteTiming` command. The problem now is - how does one fix the seams between the reassembled image fragments in order to match the output of `EdgeDetect[testImage]`?


title: Is there a package or canonical way for writing test harnesses in Mathematica?

text: I've written a complicated function `foo`.1 I'd now like to simplify this function's code, and later enhance it with more features. With each change, however, I'd like to be confident that I'm not breaking previously met specifications. So, I'm looking for a test harness to run between each change. The obvious, "poor man's" way of doing this seems to be to write a series of `If[...]` statements that check a given piece of code against expected output, and `Print` messages according to the results. Or, I could get fancier, specify my tests in a table, for example— ![enter image description here](http://i.stack.imgur.com/0SeJH.png) —and automate the testing. (If I were to continue down this route, then of course I'd have to `Hold@` the entire table to prevent cells from executing, and write a function that `Extract`s each row in turn, running the expression and checking its return value.) But, I'm wondering if there's a package in $Mathematica$ built for this purpose, or at least some canonical way of doing things that I should start getting used to, especially if I'm heading toward writing larger and larger pieces of code, maybe even packages and applications, eventually. Googling `Mathematica` `test` `harness`, I've come across some pages about _MUnit_ , which appear specific to Workbench, which I don't have. 1 In case it'd be helpful to know, my `foo` is essentially a data wrapper. Given a symbol, it copies the symbol's OwnValue elsewhere, unsets the symbol, then redefines that symbol with DownValues and UpValues.


title: How to construct tuples with a given order?

text: How do I create a list of tuples with an ordering imposed on them, where each element is from a generating set? Specifically, I'm trying to create a listing of tuples $(x_1, x_2, ..., x_n)$ such that $x_1 > x_2$, $x_2 \leq x_3 \leq \cdots x_n$ where each $x_i$ is in (say) $X = \{a,b,c,d\}$. The elements of $X$ are in lexicographic order. Code:               rank = 4;     weight = 3;          X = Range[rank];      bc = Tuples[X, weight];     Cases[bc, {x1_, x2_, x3_} /; x1 > x2 && x2 <= x3]      Issues 1. rank and weight are independent; they don't need to be =. 2. I'd like to say x1_, .., xrank_, but I'm not sure how to specify x_rank. Also x2 <= x3 <= ... <= xrank. (I'll loop on rank and weight, so these won't be hard- coded values.) 3. At the end, 1, 2, ..., rank should be traded for a, b, ... (whatever letter).


title: NotebookWrite an expression

text: I'm trying to write a notebook from the kernel, so using one list of elements in one document, I'd like to create a second document with some interactions between the elements of the list. For that, I'm already trying to write on a separate document, which works with                NotebookWrite[ newDoc, Cell[ "2+3", "Input"]]      Now, this works fine, but I'm trying to get this string "2+3" computed in the new notebook. Nor using ToExpression, Evaluate seems to be working. Any help for this? Also: is there a good book explaining these different concepts of how the Kernel works? I'm reading the online documentation, but sometimes, I'd like to have a more "book"-approach, if possible. What would you recommend? Thanks all, once again!