How to partition a disk into individually spaced bricks?

What I want to do is in any way produce a picture that looks like this ![enter image description here](http://i.imgur.com/TVnGC.jpg) > Given a set of words, how can I partition a disk into bricks for these > words, such that it looks good? Here is my sucky construction:                 h = 1.3;       w = 8;       R = 22.2;            f[m_] = Abs[Sqrt[R^2 - (R - h*m)^2]];            Table[             Table[                  {-f[m], 0} + {n*w, R - h*m} + {w, h} Random[]/10,             {n, 0, Ceiling[2 f[m]/w]}       ], {m, 0, Ceiling[2 R/h]}];            coordinates = Flatten[%, 1];      with a list                 colorlist = {"DarkRainbow", "Rainbow", "Pastel", "Aquamarine",           "BrassTones", "BrownCyanTones", "CherryTones", "CoffeeTones",           "FuchsiaTones", "GrayTones", "GrayYellowTones", "GreenPinkTones",           "PigeonTones", "RedBlueTones", "RustTones", "SiennaTones",           "ValentineTones", "AlpineColors", "ArmyColors", "AtlanticColors",           "AuroraColors", "AvocadoColors", "BeachColors", "CandyColors",           "CMYKColors", "DeepSeaColors", "FallColors", "FruitPunchColors",           "IslandColors", "LakeColors", "MintColors", "NeonColors",           "PearlColors", "PlumColors", "RoseColors", "SolarColors",           "SouthwestColors", "StarryNightColors", "SunsetColors",           "ThermometerColors", "WatermelonColors", "RedGreenSplit",           "DarkTerrain", "GreenBrownTerrain", "LightTerrain", "SandyTerrain",           "BlueGreenYellow", "LightTemperatureMap", "TemperatureMap",           "BrightBands", "DarkBands"};       colorlist2 = {colorlist, colorlist, colorlist, colorlist} // Flatten;      such that I can plot it                 Length[coordinates] "Points"       Length[colorlist2] "Items"            Graphics[Point[coordinates]]            Graphics[        Table[         {Text[Style[colorlist2[[i]], Small], coordinates[[i]]]},         {i, 1, Min[Length@colorlist2, Length@coordinates]}]        ]      * * * ![enter image description here](http://i.imgur.com/CptHV.png) ![enter image description here](http://i.imgur.com/LkMOM.png) * * * Explainations:   * f[m_] parameterizes the left edge of a cricle, then I generate the coordinates by counting from top to bottom and from left to right until I reach 2R or the bound given by f[m_], respectively.   * The vectors "{w, h} Random[]/10" are my attempt to make the thing a little more smooth looking. I like it a little shaky.   * The list of colors is of course just a random example. and I'm sure it could look better in general. * * * There are several problems with my approach. Some of them are optics, for example:   * The structure is to rigit and depending on the values R, h and w, some patterns emergy, like the bows you see in the pic.   * This might be a little difficult to resolve completely, but since some words are longer than others, the words tend to lie above each other. Other problems:   * I essentially have to match the two lists every time I change the list of words. I mean it's not the end of the world, but it's not too nice.   * In the end the words are themed and they will make up clusters, don't know if I can be helped with speeding the sorting up though.   * ... Also, I'd appreciate a hint how I can read in the strings for the script from a text file, where each line contains one of the words.


Avoiding an unresponsive user interface in OS X

I have found that despite Mathematica's numerous updates, each of which have added much functionality, one fundamental issue remains unaddressed: The unresponsiveness of the UI when I make a mistake (specifically, this is in Mac OS X, but the problem may exist in the other OSes). The problem has existed since at least Mathematica 4, and still exists in Mathematica 8. If, for instance, I define a variable f through a function, and something goes wrong in that function, the error often cascades out of control, and every single bit of code that uses f subsequently will dump out dark orange colored error messages of the form Function::errorname : Error description here. If this is in a loop with thousands of iterations, the UI can be completely unresponsive, even to repeated presses of Command + Period or quitting the kernel via the menubar. Often times, Mathematica will eat up massive amounts of memory when this happens and eventually crash. I was just wondering if people had a general strategy for avoiding this situation, aside from assiduous error checking at every stage in a program to ensure that outputs are always reasonable. My desired behavior would be to have Mathematica abort its currently-running calculation if even a single error message is produced (unless I turn them off using Off[]), but I have no idea if this is possible without explicit, repeated checks in the code to see if an error message has been thrown. Alternatively, if there is a way to say dump error messages to a file rather than attempting to store their contents within the notebook, that would perhaps avoid the memory overflows that often cause Mathematica to fail. Does anyone have an ideas on how to alleviate this issue? Thanks! **Edit:** One work-around seems to be changing the "KernelMessageAction" option within the MessageOptions folder to "PrintToConsole" instead of just "Print". This dumps the error messages to a separate window. The advantage of doing this is that the window has a "Delete All Messages" button which you can click to clear the messages from memory. I am not sure if this addresses the underlying problem of the UI becoming unresponsive, however.


plotting an Integration output

How to solve this integral by Mathematica even by numerical methods (plotting the solution)               Integrate[(Cos[x] - a)/(1 + a^2 - 2*a*Cos[x])^1.5, {x, 0, 2*Pi}]      ![enter image description here](http://i.stack.imgur.com/idazn.jpg) It consumes huge time on Mathematica 9 home edition and no output. I just want the Taylor expansion in the vicinity of a=0


In Compile "InlineExternalDefinitions" doesn't work anymore in Mma v10 like in v9

In Mma 9 using `CompilationOptions -> {"InlineExternalDefinitions" -> True}` inside of `Compile` inlined the values of the previously defined parameters used in the function to be compiled. For example:               nPara = 3;     cf = Compile[{{x, _Real, 1}},       Sum[x[[i]], {i, nPara}],        CompilationOptions -> {"InlineExternalDefinitions" -> True}       ]      resultes in: ![Output Mma9](http://i.stack.imgur.com/1PGeZ.png) and works flawless as expected. But in Mma 10 the output is: ![Output Mma10](http://i.stack.imgur.com/8v6gR.png) And, as now the value of nPara is not known to the compiled function, the comiled function doesn't work anymore. For such a simple function one can apply `Whith` as a workaround:               With[{nPara = nPara},      Compile[{{x, _Real, 1}},       Sum[x[[i]], {i, nPara}],        CompilationOptions -> {"InlineExternalDefinitions" -> True}       ]      ]      However, in bigger notebooks and with more complex functions this undocumented code break (or is a bug or a fix) causes bigger issues. Does anyone know a more convenient or automated workaround to fix this problem?


Sequentially numbering a nested list

I've got a nested list               {a, b, {c, d}, e, {f, {g, h}}}      which I want to magically transmogrify to               {{1,a}, {2,b}, {{3,c}, {4,d}}, {5,e}, {{6,f}, {{7,g}, {8,h}}}}      This is just prepending a simple sequence to each element regardless of depth. I can't think of any simple way to do this in general. My stubbornly procedural brain keeps thinking of loops and recursion, but I'm sure you more functional types have a much better trick up your sleeve.


Namespaces in Mathematica

In many programming languages one can define a namespace               with namespace abc      How can the similar be done in _Mathematica_? The `Module` and `Block` commands, can somewhat mimick this, but it is only in the command, it doesn't act as a definition. How can this be done in _Mathematica_?


Replacing more than one element from a Sublist

The following expression allows me to extract the value of `x` and `y`:               {x, y, u, v} /. #2 & @@       List[Minimize[{x - 2 y^2, 1500 >= x >= y >= 0}, {x, y}],         List[FindRoot[{v - Sin[u] == 0, v + u == 30}, {u, 0}, {v, 20}]]]~       Flatten~1      On the other hand, this expression allows me to extract the value of `u` and `v`               {x, y, u, v} /. #3 & @@       List[Minimize[{x - 2 y^2, 1500 >= x >= y >= 0}, {x, y}],         List[FindRoot[{v - Sin[u] == 0, v + u == 30}, {u, 0}, {v, 20}]]]~       Flatten~1      I want to extract the 4 values at once modifing the code, you know `{x,y,u,v} = {1500, 1500, 30.675, -0.674984}` Does anyone know how to do it? thanks!


How to generically produce iterators (to loop over many variables)

A generalization of, for example:               Do[(* stuff *), {x, listx},{y, listy},{z, listz}]        I can almost do this with Table, but I need a way to flatten the outer brackets:               Table[{s, l[s]}, {s, {x, y, z}}]            (* out: {{x, l[x]},{y, l[y]},{z,l[z]}}        But to use this List, I need really to exchange the outerbrackets to simply a sequence. If I append to the end               /.List->Sequence        It will remove all of the brackets and not give the desired result. Similar issues plague               Flatten     FlattenAt[ ,1]        etc. solutions. Is there a good way to do this?


RegionPlot3D run forever when plotting 3D ParametricRegion

when working with 2D, RegionPlot works fine with ParametricRegion as can be seen in this example:               r = ParametricRegion[{Cos[t], Sin[t]}, {{t, 0, 2 Pi}}];     RegionPlot[r]      however, when working with 3D ParametricRegion, the RegionPlot3D run forever. check this example:               r2 = ParametricRegion[{Cos[u], Sin[u] + Cos[v],          Sin[v]}, {{u, 0, 2 Pi}, {v, -Pi, Pi}}];         RegionPlot3D[r2]      nothing in the documentation said about functions ParametricRegion and RegionPlot3D that they should not be use for 3D parametric Region. any explanation why RegionPlot3D run non stop when plotting r2? MMA 10 on windows 8. thanks


How to implement a formal expectation operator over an unknown distribution?

I need to do some simplification of an expression involving averages over a stochastic variable (in order to verify a long analytical calculation). The easiest way to do that, I figured, were if I could implement an operator which would basically be short-hand for the averaging procedure, with all the appropriate properties. Then of course this operator would be present in the final expression, which is fine, and would enable me to compare easily with my own calculations. So assuming I use `x` for the stochastic variable, I tried defining `av` using               av[y_ + z_] := av[y] + av[z]       av[c_ y_] := c av[y] /; FreeQ[c, x]
       av[c_] := c /; FreeQ[c, x]        Then when I write               D[av[x y], y]      I get
av[x]      which is fine, but when I write               D[av[Exp[-x y]], y]      I get               -E^(-x y) y        instead of `-y av[Exp[-x y]]` as I want, i.e., the `av` is removed somehow. I tried using `UpValue` for teaching _Mathematica_ that it could interchange differentiation and `av`, but apparently that is not the problem. I might be going about this entirely the wrong way, but I'd be grateful for any input. Note the builtin `Expectation` function does not accomplish it either - e.g., it doesn't handle the derivatives as a proper average operator would. For example               h[y_] := Expectation[y, x \[Distributed] pp] (*pp unknown density*)      Then               D[h[Exp[-x y]], x]      gives               (Expectation^(0,1))[E^(-x y),x\[Distributed]pp] (Distributed^(1,0))[x,pp]-E^(-x y) y        (Expectation^(1,0))[E^(-x y),x\[Distributed]pp]      whereas I wanted               -y h[Exp[-y x]]      (i.e moving the derivative inside the averaging h). Sune


How can I speed up my compiled function that is returned by another function?

**Overview** I have a function that acts like the `Interpolation` on sparse $n$-dimensional data using a simple implementation of RBF interpolation method. I want my function to return a compiled function that will run fast. What I get works but it is much slower that I think it should be. **My code**               Clear[RBFInterpolation]          Options[RBFInterpolation] = {         "DistanceFunction" -> (Norm[#1 - #2] &),          "RadialBasisFunction" -> (Sqrt[#1^2 + #2^2/4] &),          "RadialScale" -> Automatic, "Debug" -> False, "Compile" -> False};          RBFInterpolation[cptab_, opts : OptionsPattern[RBFInterpolation]] :=      Module[     {ro, xpts, fundata, Φ, disfun, λ, RBF, x},           xpts = #[[1]] & /@ cptab;     fundata = #[[2]] & /@ cptab;     disfun = OptionValue["DistanceFunction"];     RBF = OptionValue["RadialBasisFunction"];          Φ =       Table[disfun[xpts[[i]], xpts[[j]]], {i, 1, Length[xpts]},{j,1,Length[xpts]}];          Which[      OptionValue["RadialScale"] == Automatic,      ro = Median[       Flatten[Table[         Drop[Φ[[i]], {i}], {i, 1,           Length[Φ]}]]],          NumberQ[OptionValue["RadialScale"]],     ro = OptionValue["RadialScale"],          True,     Print["I cannot understand \"RadialScale\"->",       OptionValue["RadialScale"], " So I'm going to make it up"];     ro = Median[       Flatten[Table[         Drop[Φ[[i]], {i}], {i, 1, Length[Φ]}]]]     ];           If[OptionValue["Debug"], Print["ro=", ro]];     If[OptionValue["Debug"],       Print["Distance function on first two points"];       Print["point 1 ->", xpts[[1]]];       Print["point 2 ->", xpts[[2]]];       Print["Distance ->", disfun[xpts[[1]], xpts[[2]]]];       Print["Radial Basis Function on Distance ->",        RBF[disfun[xpts[[1]], xpts[[2]]], ro]]     ];          Φ = Map[RBF[#, ro] &, Φ, {2}];          If[OptionValue["Debug"],          Print["Element of Φ[[1,1]]=", Φ[[1,1]]]];          λ = Inverse[Φ].fundata;          If[OptionValue["Debug"],       Print["First element of λ[[1]]=", λ[[i]]]];          If[OptionValue["Compile"],      Return[       With[{xi = x, λi = λ, xptsi = xpts, roi = ro},        Compile[{{xi, _Real, 1}},         Sum[λi[[i]] RBF[disfun[xi, xptsi[[i]]], roi], {i, 1,           Length[λ]}]]]],           Return[       Function[x,         Sum[λ[[i]] RBF[disfun[x, xpts[[i]]], ro], {i, 1,          Length[λ]}]]]       ]      ];      Most of this function is not of interest to my question. I think the key is where I `Return[]` the compiled function.               Return[       With[{xi = x, λi = λ, xptsi = xpts, roi = ro},        Compile[{{xi, _Real, 1}},         Sum[λi[[i]] RBF[disfun[xi, xptsi[[i]]], roi], {i, 1,           Length[λ]}]]]]      **Testing the Function** The following code can be used to run and test the timing of the returned function. First make a "Truth" function to sample then interpolate               Clear[truth]     truth[x_] := Product[Sin[x[[i]]], {i, 1, Length[x]}];      Make up some data               n = 100;     d = 5;     cpts = RandomReal[{-π/2, π/2}, {n, d}];     cptab = {#, truth[#]} & /@ cpts;     xpts = #[[1]] & /@ cptab;     fundata = #[[2]] & /@ cptab;      Test the speed of the returned functions               Print["Normal Function:"];     Timing[funFun = RBFInterpolation[cptab, "Compile" -> False];]     Timing[funFun[#] & /@ xpts;]          Print["Compile Function:"];     Timing[funFunc = RBFInterpolation[cptab, "Compile" -> True];]     Timing[funFunc[#] & /@ xpts;]     i = 1;     Print["Normal function: ", funFun[xpts[[i]]]];     Print["Complie function: ", funFunc[xpts[[i]]]];     Print["The real right answer: ", fundata[[i]]];      I get results like this:               Normal Function:     {0.080987,Null}     {0.123981,Null}          Compile Function:     {0.092986,Null}     {0.156977,Null}          Normal function: -0.0182901     Complie function: -0.0182901     The real right answer: -0.0182901      So as you can see it works but it is not faster. How do I make this faster? **Simpler test that is faster!?** The code:               n = 10;     a = RandomReal[{-1, 1}, n];     f = Table[2 π i, {i, 1, n}];     ϕ = RandomReal[{0, 2 π}, n];     Clear[Nfun]     Nfun[t_] := Sum[a[[i]] Cos[f[[i]] t + ϕ[[i]]], {i, 1, n}];     Nfunc = Compile[{{t, _Real}},      Evaluate[Sum[a[[i]] Cos[f[[i]] t + ϕ[[i]]], {i, 1, n}]]];          Clear[makeNfunc]     makeNfunc[a_, f_, ϕ_] := Module[{n},     n = Length[a];     Return[      Compile[{{t, _Real}},        Evaluate[Sum[a[[i]] Cos[f[[i]] t + ϕ[[i]]], {i, 1, n}]]]]     ];     NfuncR = makeNfunc[a, f, ϕ];      Run the code:               npts = 10000;     data = RandomReal[{0, 10}, npts];     Timing[Nfun[#] & /@ data;]     Timing[Nfunc[#] & /@ data;]     Timing[NfuncR[#] & /@ data;]      The output:               {0.585911, Null}     {0.012998, Null}     {0.012998, Null}      So in this simple case the compiled code is about 45 times faster for both the function compiled inline `Nfunc` and the function that was returned by the `makeNfunc`, `NfuncR` So the question is what is the problem with my original function above?


Incorrect result from Integrate

I attempted to calculate the following integral:               Integrate[ Sqrt[x] Exp[-(x - a)^2], {x, 0, ∞}, Assumptions -> a > 0]          1/(4 Sqrt[a])I E^(-(a^2/2)) π( a^2 BesselI[-(1/4), a^2/2] - (1 + a^2) BesselI[1/4, a^2/2]                                  + a^2 (BesselI[3/4, a^2/2] - BesselI[5/4, a^2/2]))      This is obviously incorrect, since applying the rule $a \rightarrow 0.3$ yields $-0.37\mathrm{i}$, whereas the correct result obtained from `NIntegrate` is $0.907$. I have two questions:   1. Does anyone know the correct answer? And perhaps more importantly,   2. Does anyone have any idea why such a simple integral is resulting in a completely incorrect output? I find it disturbing that the program is capable of yielding incorrect results without warning to the user. In this case the answer was obviously wrong, but what about for more complicated expressions? Note: removing the `Assumptions` option still yields the same incorrect result.


Using Mathematica as a data visualization front end for .Net applications?

I have a C# application that has 3-dimensional data that I wish to plot. Controls in C# for surface modeling are, in my experience, rather limited. I wish to have my C# application send the 3D point mesh data to Mathematica `Plot3D` and display the result in a winform or some other front end (notebook?). Essentially, my goal is to use Mathematica as a generalized data visualization tool from my C# applications. So far, I have been able to generate a picture file from Mathematica that I put in a `MathPictureBox` control which resides on a winform. However, I would like the interactivity you get when using `Plot3D` from a notebook. Is this possible?


Selecting morphological components by clicking on them?

This is a bit of a follow-up to a previous question: How can I merge multiple sets of morphological components (perhaps selected using different metrics)? I've run into a few problems recently where it's actually rather difficult to select morphological components in an image based on size or geometry metrics, and really it would be much easier to just click on them, or to select them based on a coordinate in their interior. Consider the task of selecting an arbitrary subset of morphological components in this image:               Import["http://i.stack.imgur.com/gSXIj.png"]      Is something like this possible? * * * Here's an update based on nikie's comment, where I believe he's suggesting we can do this:               image = Binarize[Import["http://i.stack.imgur.com/gSXIj.png"]];     m = MorphologicalComponents[image];     m // Colorize          exMorphologicalComponentNumOne = PixelValue[Image[m], {50, 214}]     exMorphologicalComponentNumOneTEST = PixelValue[Image[m], {49, 213}]          exMorphologicalComponentNumTwo = PixelValue[Image[m], {206, 146}]     exMorphologicalComponentNumTwoTEST = PixelValue[Image[m], {203, 142}]      This, I believe, is telling us the index value for the morphological components containing the pixels at {50, 214} and at {206, 146} in the image. Here, `PixelValue` simply takes a pixel coordinate and returns whatever is sitting at this index in `ImageData[image]`. So if you look at the output for `MorphologicalComponents[image]`, you'll notice that the matrix is the same size as the output from `ImageData[image]` and that the positions in the image corresponding to a morphological component carry the value of the component's index. This is a very good start (thank you nikie!), but it still isn't clear to me how to quickly select a subset of morphological components based on their index. It would also be really nice to be able to to the click-based selection I mention in the title, since here, we have to write down and retype coordinates using the locator pane. This becomes kind of time consuming if we need to select a large subset of morphological components in multiple images.


Visualize difference between members of the list

I want to visualize the difference between members of a set:               set = {20, 36, 70, 96, 152, 301}      This way I get the diffs:               diffs = Select[#[[2]] - #[[1]] & /@ Tuples[{set, set}], # > 0 &]          {16, 50, 76, 132, 281, 34, 60, 116, 265, 26, 82, 231, 56, 205, 149}      But how can I put the diffs as a caption over graph like lines between members?


Mathematica 8: ContourPlot finding out max and min function values

I have a ContourPlot where I have let Mathematica draw the contours automatically. I would like to extract the zmax and zmin contour values that have been determined internally so that I can pass them to ShowLegend to be shown with the color-bar. _I am using Mathematica 8._               Needs["PlotLegends`"]     plTest = ContourPlot[xv^2 + yv^2, {xv, 0, 1}, {yv, 0, 1},        Contours -> 9, ColorFunction -> "Rainbow"];     ShowLegend[plTest, {ColorData["Rainbow"][1 - #1] &, 10, "max", "min",        LegendPosition -> {0.6, 0}, BaseStyle -> {FontSize -> 14}}]       I would like the actual zmax and zmin values to appear in the colorbar in the legend instead of the "max" and "min" above. Can someone please help me with this? There is a similar post: ShowLegend values , but I can't get this to work with ContourPlot type. Thanks.


Wavelet Packet Transform in Mathematica 7 and 8

For finding location of spikes in a time series I used to transform the data into wavelet space using               DiscreteWaveletPacketTransform [ data, filter, 0]       and then shrink the basis using the universal threshold in Mathematica version 7 and now every single command, corresponding to wavelets, is changed in version 8. Is there anybody who can tell me how can I do in version 8 again? I guess I need to use `WaveletBestBasis` command, but how?


Mathematica: ListDensityPlot behavior different for arrays and points

I am using ListDensityPlot to output the results of a physical simulation. I've passed both an array of values and coordinates coupled with magnitudes to ListDensityPlot. Although I expect identical functionality it seems the points are interpolated differently. I've recreated the problem in a very simple case in this code:               ListDensityPlot[{{1, 1, 2}, {2, 1, 2}, {3, 1, 1}, {4, 1, 1}, {1, 2, 1},                       {2, 2, 1}, {3, 2, 1}, {4, 2, 1}}, InterpolationOrder -> 1]     ListDensityPlot[{{1, 2, 1, 1}, {1, 1, 1, 1}},      InterpolationOrder -> 1]      Toggling the third element of a list in the first function call from 1 to 2 causes a change (since all are 1), and changing any element in a list in the second function call from 1 to 2 does the same. The input in the first call should be identical to that in the second. However, it seems that ListDensityPlot is using a different algorithm for smoothing in each case. I have tried altering the order in the first call, but this changes nothing. Am I missing something or is this a known feature that I will have to work around?


Strange behaviour of Set and Part when given a sequence

Consider this example:               lis1 = {a, b, c};     lis1[[2]] = Sequence[e, f];     lis1     (*{a, e, f, c}*)     lis1[[2]]     (*e*)     lis1[[2]] = Sequence[g, h];     lis1     (*{a, g, h, c}*)      It looks like position 2 in lis1 is still has head `Sequence`, yet no sign of `Sequence` in the full form of lis1. Can any one explain why is this happening?


Different highlight for each cluster in DendrogramPlot

Is there any way to have each cluster in the `DendrogramPlot` highlight in a different color? I've tried the obvious way but it doesn't work:               Needs["HierarchicalClustering`"]     data = {{0.758587,0.844749},{1.05549,1.01289},{1.21689,1.1919},{0.53086,0.977943},{2.08582,1.8978},{2.10121,1.81776},{1.88505,1.83257},{1.89067,2.48317},{2.88711,1.02682},{2.82199,0.901863},{2.90456,0.91189},{2.80032,1.09192}};     DendrogramPlot[      data,      LeafLabels -> Range[12],      HighlightLevel -> 3,      HighlightStyle -> {Red, Green, Blue}      ]      ![Mathematica graphics](http://i.stack.imgur.com/16lSy.png)


Differentiation of Vector Equation

Is it possible to get symbolic derivatives of equations with vectors as arguments without specifying every vector element explicitly. Something like               f[A_Vector, B_Vector] := Dot[A, B]     D[f[a, b], a[[1]]]


Obtaining standardised regression coeffiecients

Regression coefficients are the constant that indicate the rate of change in one variable as a function of change in another. Standardised regression coefficients are the same, but refer to a change in number of standard deviations. Using LinearModelFit and the "ParameterTable" property I am able to obtain unstandardised regression coefficients (parameter estimates), but I would like to know if there is a also a way to quickly obtain standardised regression coefficients. What I am currently doing:               model = LinearModelFit[data, x, x]     model["ParameterTable"]


What's the cleanest functional-programming style way to perform this list operation?

I am looking for the correct method for accomplishing the unknown piece in the following code snippet:               rolls = Tuples[Range[1, 4], {2}]      > >     {{1, 1}, {1, 2}, {1, 3}, {1, 4}, {2, 1}, {2, 2}, {2, 3}, {2, 4}, {3, 1}, > {3, 2}, >     {3, 3}, {3, 4}, {4, 1}, {4, 2}, {4, 3}, {4, 4}} >                 Tally[rolls, Min[#1] == Min[#2] &]      > >     {{{1, 1}, 7}, {{2, 2}, 5}, {{3, 3}, 3}, {{4, 4}, 1}} >                 (*Unknown List Manipulation Code*)      > >     (1*7 + 2*5 + 3*3 + 4*1)/Length[rolls]   >     (*where previous result is in form {{{a, b}, c}, ...} >     the numerator is the sum of Min[a,b]*c for every item in the list that > is >     the previous result) >   I can imagine some very complex solutions, but I suspect that there is an elegant functional solution that I am missing.


Special Mathematica Cell to work with R code

I have enjoyed working with R inside _Mathematica_. But it would be nice If I could have a special R cell. For example, instead of typing               REvaluate["{           data(iris)           reg <- lm( Sepal.Length ~ Species, data=iris )           summary.text <- capture.output(print( summary(reg)) )        }"]      I would change the cell style to the special R code one and simply type in the code as I would do in a terminal window. Like so:                 data(iris)       reg <- lm( Sepal.Length ~ Species, data=iris )       summary.text <- capture.output(print( summary(reg)) )      Is there some way to create such a FrontEnd cell? In the future I would like _Mathematica_ to have code highlighting and autocompletion for such cells. This would make _Mathematica_ the best environment for working with R.


TemporalData frequency option as in R

I'm studying R, and am very impressed by the simplicity of some commands and in the way R handles temporal data. For example, in R, if you have some one- dimensional temporal data, you can easily transform it into a data series using:               url<-"http://www.massey.ac.nz/~pscowper/ts/cbe.dat"     data<-read.table(url,header=T)     timeSeriesCol1=ts(data[,1],start=1958,frequency=12)      In _Mathematica_ , we have the new `TemporalData` function, but to do the same as in R, the code is a little clumsy due to the lack of frequency option or an equivalent. See the code:               url="http://www.massey.ac.nz/~pscowper/ts/cbe.dat";     data=Import[url];     timeSeriesCol1=TemporalData[Rest@data[[All,1]],{{1958,1},DatePlus[{1958,1},{Length[data],"Month"}]}]     DateListPlot[N@timeSeriesCol1["Path"]]      The part `{{1958,1},DatePlus[{1958,1},{Length[CBE],"Month"}]}` is very inelegant and `DateListPlot` does not directly recognize the object (and you need to convert it to a number, which look likes a bug). Does anyone have a clue for a more elegant way to handle this using `TemporalData`?


NDSolve and WhenEvent Causing Excess Work

When I use the following system               model = {x'[t] == x[t] (1 - x[t]) - x[t] y[t], y'[t] == x[t] y[t] - y[t], x[0] == 0.5, y[0] == 0.5}      with the `WhenEvent`               perturb = WhenEvent[Mod[t, 1],         {x[t] -> x[t], y[t] -> y[t]}     ];      chosen to be trivial, I have what seems to be strange behavior to me, namely if I do the following integration               NDSolve[{model, perturb}, {x, y}, {t, 0, 10000}]      I get an error that the integration reached maximum steps at `t==8670.`, even though nothing is changing. If I increase the `MaxSteps` I can get it to integrate. So my question is if this is expected? The longer you integrate a system when using a `WhenEvent` the larger the `MaxSteps` you will need? I can replicate this same behavior when I use initial conditions that are on a stable equilibrium value ... so truly nothing is changing.


How to rename a built-in function?

I want a built-in function renamed without loss of any properties, I want the shorter name to appear in all results and to be recognized as input. Is it possible?


Where is KeyEventTranslations.tr in Mathematica 9?

I can't find the file in it's usual place /Library/Mathematica/FrontEnd/... was it removed?


Plotting with multiple variables

What is the simplest way of plotting across multiple variables? eg: I would like to plot something like this:               Plot[{x^0,x^1,x^2,x^3,x^4,x^5,x^6}, {x, 0, 10}]      using a simple command like this:               Plot[x^n, {x, 0, 10}, {n, 0, 6}]      (I realise this is not syntactically correct, but hopefully it will serve to illustrate the point.)


How can I get precise frame rates in dynamic?

I've been the Spritz sdk in my ios apps, and I love it. For funsies I wanted to see how much less code a mathematica version would take! Using dynamic I get a nice result, shown below in code. However, I'm not so sure about the accuracy of the reading rate that I display (in words per minutes). How can I check and see if it is displaying an accurate frame rate with my usage of Dynamic[]? Also, What should the upper limit of the rate in the slider be calculated?               aliceInWonderlandWords = StringSplit@ExampleData[{"Text","AliceInWonderland"}];     optimalRecognitionPoint[w_String] := With[{len = StringLength[w]},         Which[len==1||len==2, len, len==3, 2, True, Round[len*0.49,1]]     ]          $maxLength = 20;          flashWord[word_String, maxWordLength_:20] := Module[         {redIndex = optimalRecognitionPoint[word], leftPart, rightPart, chars, row},         leftPart = $maxLength/2-redIndex;          rightPart = $maxLength-(leftPart+StringLength[word]);         chars = MapIndexed[Style[#1, If[First[#2]==redIndex, Red, Black]]&, Characters@word];         row = ArrayPad[chars, {leftPart, rightPart}," "];         Style[             Grid[ArrayPad[{row},{1,1},Table["",{Length[row]}]],             Dividers -> {(maxWordLength/2+1) -> True,False}, Spacings->{.2,.5}],              FontFamily -> "Monaco", FontSize -> 24 (* This must be a fixed width font! *)         ]     ];          spritzDemo[words_] := DynamicModule[         {rate = 500/60},             Panel @ Column[{             Row[{Slider[Dynamic[rate], {500/60, 2000/60}, Appearance-> Large,ImageSize->140],                  " ", Dynamic[IntegerPart[rate*60]], " words per minute"}," "],             Animate[flashWord[words[[progress]]], {progress, 1, Length[words],1}, AnimationRate -> Dynamic@rate]         }]     ]     spritzDemo[aliceInWonderlandWords]      And for bonus points - how could I shorten the code and put the controls into a single panel?


Debugging memory leaks

I've written my incredibly complex, incredibly elegant analysis function, that works great on small test data. But when I run it on my real (bigger) data set it keeps running out of memory. It turns out that the analysis function does not free memory, but I can't imagine why. It takes a large number of points, but returns only several scalar values. ![memory usage after time](http://i.stack.imgur.com/2YeTS.png) Every time I run this it takes up about 500 MB of memory. (here is another example). **What is the best way to debug memory problems?** I've read the memory management tutorial, turned off caching and verified I have no lingering variables in my contexts and of course I have set `$HistoryLength` to zero. Also running `Reverse@Sort[{ByteCount[Symbol[#]], #} & /@ Names["`*"]]` show no huge memory symbols. Just the data:               {{191816648, "alldata"}, {28184, "before"}, {28184, "after"},      {24096, "compiledSelectBin"}, {15344, "AppendLeftRight"}, {8840, "compiledSelectBinFunc"}...}      **EDIT** One can use this code to track memory consumption:               DynamicModule[{pm = {}},      Dynamic@Refresh[pm = Append[pm, MemoryInUse[]];         If[Length[pm] > 120, pm = Drop[pm, 1]];         ListPlot[pm/1024/1024, AxesLabel -> {"Time [s]", "Memory [MB]"},          PlotRange -> {0, All}], UpdateInterval -> 1,         TrackedSymbols :> {}]]      I _think_ I finally have a minimum example. Here it is. Unzip to a folder and evaluate the two cells in LeakP.nb. If you evaluate the second cell multiple times you can watch the memory consumption grow. **Could somebody (on win7 64 bit mma 8) confirm this?** **EDIT 1** I _really hope_ I have nailed it down. Here is a self contained example:               $HistoryLength = 0;     data = RandomReal[{-1, 1}, {10, 100000, 2}];     data = Developer`ToPackedArray[#] & /@ data;     data = Flatten[data, 1];     Dimensions[data]     HistogramList[data, 30, Automatic];     ClearAll[data]; ClearSystemCache[];      **EDIT 2** This is fixed in _Mathematica_ 9.0.0.


Is it possible to insert a link preceding the Wolfram link at the bottom of html documents?

At the bottom of the html document produced by Mathematica is a link to Wolfram's site. It says: Created by **Wolfram _Mathematica_ 8.0** I think it would be nifty to have the option to precede that link with a custom link. For example: Copyright 2012, **Fred Daniel Kline** - foo@bar.com _Note: I prefer my email as an image to prevent netbots from grabbing it._ Perhaps we could have a special cell that, if present in the notebook, would be displayed automatically. Edited: Also would like this option for pdf's.


Manipulators and Dynamic in more concise code

Is there a way to update dynamic variables through a function. I was looking back at one of the answers from Heike where she showed me how to make my custom `Manipulate`. What I'm finding very annoying is having to copy and paste code for every variable I have to update. Consider this:               Panel[         DynamicModule[             {             a = 1, b = 100,             c = a + b + 1, d = a - b + 1             },              Column[{                 Grid[{                     {                     MyControl[Manipulator[Dynamic[a, (a = #; c = a + b + 1; d = a - b + 1) &], {0, 1}],"a", Dynamic[PaddedForm[a, 5]]],                     MyControl[Manipulator[Dynamic[b, (b = #; c = a + b + 1; d = a - b + 1) &], {100, 200}], "b", Dynamic[PaddedForm[b, 5]]],                     }                     }, Alignment -> Left],                 {Dynamic@c, Dynamic@d}             }],             Initialization :> (                 MyControl[manip_, left_String, right_] := Row[{Style[left, "TI", 14], manip, right}, Spacer[1]];             )         ],          ImageSize -> {600, 100}     ]      This allows me to change `a` and `b` and every time I change them `c` and `d` get updated and they are displayed: ![screenshot](http://i.stack.imgur.com/WTaiR.png) Question, is there any way to remove the redundancy of the code? I would love to have a function which updates all the variables, in this case, `c` and `d`. For instance I want something like this:               Panel[         DynamicModule[             {             a = 1, b = 100,             c = a + b + 1, d = a - b + 1             },              Column[{                 Grid[{                     {                     MyControl[Manipulator[Dynamic[a, (a = #; updateVars[]) &], {0, 1}],"a", Dynamic[PaddedForm[a, 5]]],                     MyControl[Manipulator[Dynamic[b, (b = #; updateVars[]) &], {100, 200}], "b", Dynamic[PaddedForm[b, 5]]],                     }                     }, Alignment -> Left],                 {Dynamic@c, Dynamic@d}             }],             Initialization :> (                 MyControl[manip_, left_String, right_] := Row[{Style[left, "TI", 14], manip, right}, Spacer[1]];                 updateVars[] := (c = a + b + 1; d = a - b + 1);             )         ],          ImageSize -> {600, 100}     ]      That way, if later on I introduce something else that needs to be updated every time I move a single sliders then I can just add it to `updateVars`. Unfortunately, the above does not work. Anyone knows how to make it work?


Using TetGen in Mathematica to get 3D Voronoi diagram

In this post, the use of TetGen for 3D Voronoi tesselation has been briefly discussed. However there is still no info about the use of TetGen to generate a 3D Voronoi diagram. The TetGen documentation is very brief about this feature, and there is no example how to generate the voronoi diagram shown in the documentation. I found out that one needs to use the "v" switch (in contrary to the documentation which claims this switches on the verbose mode), based on some quotes on the Web. However if I try the Mathematica interface TetGenLink I fail to get any information on the 3D Voronoi diagram. I tried out the following sequence. First I loaded the TetGen Link and generated 8 3D points to keep the graphical output simple.               Needs["TetGenLink`"];     RandomSeed[12345];     pts = RandomReal[{-1, 1}, {8, 3}];      Then I generated an TetGen Instance               inInst = TetGenCreate[]      To automatically generate an boundary for a potential Voronoi diagram (even if I do not know this would work) I extracted the ConvexHull of the point set and assigned all points and the convex hull faces to the instance               {ptshull2, surfacehull2} = TetGenConvexHull[pts];     TetGenSetPoints[inInst, ptshull2]     TetGenSetFacets[inInst, {#} & /@ surfacehull2]      please note that the face indices have to be enclosed into additional list brackets, otherwise you'll get an TetGen error. Then I define a Wireframe visualization function to display tetrahedrons.               TetrahedraWireframe[i_] :=       Line[ Flatten[         i[[All, #]] & /@ {{1, 2}, {2, 3}, {3, 1}, {1, 4}, {2, 4}, {3, 4}}, 1]]      Finally I fire TetGen by doing               outInst = TetGenTetrahedralize[inInst, "v"]      extract the results from the TetGen run by doing               coords = TetGenGetPoints[outInst];     elements = TetGenGetElements[outInst];      And visualize the resulting Tetrahedrons               Graphics3D[{GraphicsComplex[coords, TetrahedraWireframe[elements]],      PointSize[Large], Point /@ coords, Red, Point /@ pts}]      which yields the following graphical output ![Resulting Tetrahedron Mesh](http://i.stack.imgur.com/RZToA.png) I naively hoped that somehow by using this procedure I would get the Voronoi diagram, but it seems that this is not available in Mathematica. Furthermore the "v" switch does not have any effect it seems. Any ideas about convincing Mathematica to return the Voronoi diagram are most welcome. Already upfront: I'm aware that there are other solutions possible, mentioned in the above post, like using mPower to link to QHull for instance. However I would like to use the TetGen link since it is well integrated into Mathematica. Another option would be to get QHULL integrated into Mathematica in a similiar fashion like TetGen, but for whatever reason this has not been done yet. The mPower approach lacks significant performance (since it is firing qhull through the run command) compared to the speed of the TetGen implementation.


Solving a trig equation

I am trying to find an explicit solution to a trigonometric equation. It is running for a long time and I didn't get any result, but Maple solves it quickly. Why ?               Solve[ γ == ArcCos[ Cos[α] Sec[θ] ] + ArcCos[ Cos[β] Sec[θ] ], θ]


Getting the interpolation function from a list plot

I have conducted a chemistry experiment and obtained a list of concentrations of a reactant against time. I plot a graph of this using Mathematica's `ListPlot` functionality, as follows:               ListPlot[{{0, 0.562}, {10, 0.523}, {20, 0.480}, {30, 0.438}, {40, 0.398}, {50, 0.357},      {60, 0.320}, {70, 0.285}, {80, 0.255}, {90, 0.230}, {100, 0.220}}, Joined -> True,      InterpolationOrder -> 2, Mesh -> Full, AxesLabel -> {"Time (s)", "[A] (moldm^-3)"}]      This produces the graph below: ![enter image description here](http://i.stack.imgur.com/z7ds6.png) However, I wish to calculate the rate of reaction, for which I need the first derivative at $t=0$. I want to be able to get the interpolating function used by the `ListPlot` function when I specify `InterpolationOrder -> 2`, is this possible? Thanks in advance!


What Algorithm Does Mathematica use to Calculate Betweenness Centrality for Unweighted Graphs?

Recently asked this question http://math.stackexchange.com/questions/888369/betweenness-centrality-how- long-does-mathematica-take on the Mathematics SE. Does anyone know, as a follow up, what algorithm Mathematica uses to calculate the betweenness centrality vector (of $N$ elements) for an unweighted graph?


Differentiating ParametricNDSolve solutions

Is there any way to differentiate a solution obtained by `ParametricNDSolve`? For instance, I have the position $\phi_\gamma(t)$ as a function of time, parametrized by the constant $\gamma$. Now I want to differentiate with respect to time but keep the result a `ParametricFunction`. If my solution is called `xp`, simply writing `D[xp,t]` does not work, and it does not seem possible to seek for a solution of $\frac{d}{dt} \phi_\gamma(t)$ in the command of `NDSolve` or `ParametricNDSolve`, although one can differentiate an `InterpolationFunction` obtained by `NDSolve`. So, is there a way to differentiate a `ParametricFunction` with respect to the variable (or the parameter)?


Calculate variance of random walk?

How can I symbolically calculate the variance of the following random walk in _Mathematica_? Given several discrete random variables such that $p(Z_i=1-2k)=p$, where $k$ is a small real number, and $p(Z_i=-1)=1-p$, a random walk is the sum $X_t = \sum\limits_{i=1}^t Z_i$. The expectation is given by: $$\mathbb{E}[X_t] = \sum\limits_{i=1}^t\mathbb{E}[Z_i] = \sum\limits_{i=1}^tp(1-2k) -(1-p) = (p(1-2k)+p-1)t$$ I would like to calculate the variance of the random walk $Var[X_t]$. I tried using `EmpiricalDistribution`, but it does not accept symbolic values. **EDIT** After a bit more research into Mathematica's documentation I found the function TranformedDistribution. Since my random walk does not have unit steps I thought maybe the distribution can be obtained from a Bernoulli like this:               TransformedDistribution[      If[\[FormalX] == 1, 1 - 2 k, -1], \[FormalX] \[Distributed]        BernoulliDistribution[p]]      Could someone please show me how to use this to calculate $Var[X_t]$? As someone in the comments said, the variance of $X_t$ is the sum of variances of $Z_i$ so at some point I will have to calculate $E[Zi^2]$ where $Z_i$ is a tranformed Bernoulli distribution like I attempted above?


FindRoot runs out of memory in Windows but not on Mac

I am using `FindRoot` to find solutions to a large, highly oscillatory equation which I generated using other code. When I run `FindRoot` in _Mathematica_ 8 on my old macbook with OS 10.6, 1 GB Ram it takes maybe 2 hours to find a solution, but it can find a solution. I tried to run `FindRoot` on the same equation in Mathematica 9 on a PC using Windows 7 with 6 GB Ram and the system runs out of memory giving an error > No more memory available. Mathematica kernel has shut down. Try quitting > other applications and then retry. I am just running `FindRoot` so I cannot change the code, but I am wondering why I would run out of memory in Windows and not on my mac and how I could solve this problem in Windows? Are there just settings I can change in _Mathematica_ or Windows?


Rearranging a set of numbers

I have this set of numbers, that is a range of prices (ie 6-10) and a quantity of products (5)               6 - 10:   5     11 - 15:   8     16 - 20:   15     36 - 40:   63     41 - 45:  1     46 - 50:  1     51 - 55:  5     56 - 60:  3     61 - 65:  140     66 - 70:  120     71 - 75:  95     86 - 90:  2     91 - 95:  2     96 - 100:  12     101 - 200:  150     201 - 300:  300     301 - 400:  1     401 - 500:  1     501 - 600:  1     601 - 700:  1     1201 - 1300: 1     1301 - 1400: 1      And I want to obtain ranges like this ones               0 - 60:  111     61 - 65:  140     66 - 70: 120     71 - 100:  111     101 - 200: 150     201 - 300: 300     301 - 1400 : 6      The idea is to obtain less ranges, with similar quantities (grouping the original ones). Is there any way to do this for any set of ranges? How can I handle the deviation when one number is too high?


Cannot run Mathematica C-interfacing examples 'factor'

I am trying to run a Mathematica example concerning Mathematica interfacing issues with C programs. In particular I am trying to call a Mathematica function from C. Example `factor.c` is the best in my case. As explained here at the _Invoking the Mathematica Kernel from Within a Prebuilt Example_ section, I successfully build the examples (using the makefile through `make all`). After that I run the exaple as explained by typing:               ./factor -linkmode launch -linkname 'math -mathlink'      But I get back to my shell after launching the program with no output as I did nothing. Then I try again just by launching `./factor`, the program then asks me: `Create link:`, so I type `'math -mathlink'`, prfess ok, then it prompts: `Integer to factor:`, I type a 6 digit one and after that the program blocks (it waits for something, but after 5 minutes I kill it). Consider that I am on Unix. My Mathematica installation is in this path `/home/myuser/progs/Mathematica...`. I run the example respectively with Mathematica running and not running. Same results. How to make the example work? ### Something strange When I kill theprograms that I launch but stay on wait as I described before, it seems that they finally got killed, but it is not! When I try `ps` on my shell, they are there!!! Need to send `SIGKILL` to definetely get rid of them... ### About links... I bumped into a Mathematica function called LinkCreate. Maybe I need to run Mathematica, open a link from the interface, and then launch the example? I am trying some, so far no results, will keep on doing so...


Manipulating plot of random iterated function system fractal

I'm generating the Sierpinski Gasket by implementing a chaos game in mathematica. What I'd like to do is create an interactive manipulation with a slider, whereby moving it forward, plots all the points produced at each level of iteration (described in the code below). I'd also like to associate each point with a color depending on the affine transformation that was used to produce it. There are three affine transformations being used for this iterated function system $W_{1},W_{2},W_{3}$. So, if a point was produced using $W_{1}$, I'd like to color it red. If a point was produced with $W_{2}$, then color it blue, and so on. How would I go about doing this, preferrably using the code I've concocted thus far? ![enter image description here](http://i.stack.imgur.com/ecfz6.png) Here is the code I've made thus far:               Clear[A, B, W, X, i, ITERATIONS, roll]          (*Transformation matrices A[i] given below*)     A[1] = {{0.5, 0}, {0, 0.5}};     A[2] = {{0.5, 0}, {0, 0.5}};     A[3] = {{0.5, 0}, {0, 0.5}};          (*Translation vectors B[i] are defined below*)     B[1] = {0, 0};     B[2] = {1/2, 0};     B[3] = {1/4, Sqrt[3]/4};          (*Format of affine Transformation*)     W[i_, X_] := A[i].X + B[i]          RandomComponent := Random[Real, {0, 1}];          (*Initial point within bounds of unit square*)          X[0] = {RandomComponent, RandomComponent};          (*Iteration Process is defined here:     At each level of iteration we roll a standard dice. Depending on the \     outcome, we apply one of the affine transformations defined above to \     the point provided  during the previous level of iteration*)          ITERATIONS = 100000;     X[i_] = For[i = 0, i <= ITERATIONS, i++,        roll = Random[Integer, {1, 6}];            If[roll == 1 || roll == 2,             X[i + 1] = W[1, X[i]],             If[roll == 3 || roll == 4,              X[i + 1] = W[2, X[i]],              If[roll == 5 || roll == 6,               X[i + 1] = W[3, X[i]]]]]]          fractal1 = Table[X[n], {n, 1, ITERATIONS}];               ListPlot[fractal1, Axes -> False, AspectRatio -> Automatic,       PlotStyle -> {PointSize[0.001]}]         **UPDATE 1 (Code for interactive plot):** Here is the code for interactively plotting the Sierpinski Triangle via a Random Iterated Function System. The coloring aspect is still something I'm trying to work on as I wrangle through J.M.'s code. I was already aware of the affine transform and nested list functionality, but for the sake of my audience, I didn't resort to using it until now. The RandomChoice function has been very useful, credits to J.M. for pointing this out.               Clear[W, W1, W2, W3, P1, P2, P3, X, n, x]          (*The Affine Transformations*)          W1 = AffineTransform[{{{0.5, 0}, {0, 0.5}}, {0, 0}}];     W2 = AffineTransform[{{{0.5, 0}, {0, 0.5}}, {1/2, 0}}];     W3 = AffineTransform[{{{0.5, 0}, {0, 0.5}}, {1/4, Sqrt[3]/4}}];          (*Their Associated Probabilities (weights)*)     P1 = 0.33;     P2 = 0.33;     P3 = 0.34;          RandomComponent := Random[Real, {0, 1}];          (*Produces Initial Point*)     X[0] := {RandomComponent, RandomComponent}          (*Chooses Affine Transformations according to their weights*)          RandomChoice[{P1, P2, P3} -> {W1, W2, W3}];          (*Applies selected transformation to given point*)          W[x_] := RandomChoice[{P1, P2, P3} -> {W1, W2, W3}][x];          (*NestedList provides us with a way of collecting the output from \     iterating W[x_]*)          Clear[n]     Animate[ListPlot[BlockRandom[NestList[W, X[0], n]], Axes -> False,        AspectRatio -> Automatic, PlotStyle -> {PointSize[0.006]},        PlotRange -> {{0, 1}, {-0.09, 1}}], {n, 0, 10000, 1},       DisplayAllSteps -> True, AnimationRunning -> False,       AnimationRate -> 1000]          X[0];      The result is: ![enter image description here](http://i.stack.imgur.com/omHId.png)


How to draw tiles with different height?

I have a random matrix `RandomReal[{1, 2}, {20, 20}]`, whose elements represent the heights of an array of tiles. The cross sections of each tile are square and identical, viz, 10 x 10. How can I draw such a 3D structure? In addition, I need to put several layers on each tile, and each layer has the thickness of 0.5. In this case, how can I draw the whole structure or its cross section? Will partial transparency help? Here is my code:               lambda= 500;     n1 = 1.5; n2 = 1.3;     h1 = lambda/4/n1; h2 = lambda/4/n2;     NQWS = 5;     Wx = 300; Dy = 300;     NX = 20; NY = 20;     h = lambda + RandomReal[{0, 2 lambda}, {NX, NY}];     corner1 =        Flatten[Table[{i*Wx, j*Dy, 0}, {i, 0, NX - 1}, {j, 0, NY - 1}], 1];     corner2 =        Flatten[Table[{i*Wx, j*Dy, h[[i, j]]}, {i, 1, NX}, {j, 1, NY}], 1];     h1corner1 =        Flatten[Table[{i*Wx, j*Dy,           h[[i + 1, j + 1]] + k*(h1 + h2) + h1}, {i, 0, NX - 1}, {j, 0,           NY - 1}, {k, 0, NQWS - 1}], 2];     h1corner2 =        Flatten[Table[{i*Wx, j*Dy, h[[i, j]] + k*(h1 + h2)}, {i, 1, NX}, {j,           1, NY}, {k, 1, NQWS}], 2];     h2corner1 =        Flatten[Table[{i*Wx, j*Dy, h[[i + 1, j + 1]] + k*(h1 + h2)}, {i, 0,           NX - 1}, {j, 0, NY - 1}, {k, 0, NQWS - 1}], 2];     h2corner2 =        Flatten[Table[{i*Wx, j*Dy, h[[i, j]] + k*(h1 + h2) + h1}, {i, 1,           NX}, {j, 1, NY}, {k, 1, NQWS}], 2];     Graphics3D[{EdgeForm[None], Blue,        Table[Cuboid[corner1[[i]], corner2[[i]]], {i, 1, NX*NX}],        Opacity[0.8], Gray,        Table[Cuboid[h1corner1[[i]], h1corner2[[i]]], {i, 1, NX*NX*NQWS}],        Opacity[0.1], Red,        Table[Cuboid[h2corner1[[i]], h2corner2[[i]]], {i, 1, NX*NX*NQWS}]},       Boxed -> False, Lighting -> "Neutral"]      and the following picture is the output structure: ![rough surface](http://i.stack.imgur.com/i5QuV.png) Well, I hope to get one like this: ![SEM](http://i.stack.imgur.com/gQoOe.png) If I just take the top view in my picture, I cannot tell the difference between the tiles of different heights. Any comments?


Problem with importing numbers resulting from an executed file in Mathematica

I am running Mathematica 10 and I have a mathematica file, MBdebug.m, that contains the line                val = Import["! ./MBpart1ep0", "Table"];      MBpart1ep0 is an executable generated by a fortran program and has been tested to generate 3 numbers by running `./MBpart1ep0` on a Linux terminal (see below). These 3 numbers are used when the Mathematica notebook MBresolveDebug.nb is ran.               $ ./MBpart1ep0     0.4940656458412465-323   8.651144521298990       495.6336980600139      However, it seems like these values are not imported into the Mathematica Table or val. **How can I get these numbers imported into Mathematica?** You can see for yourself if you download and run these files. The README_debug.txt contains the simple 4 steps of instructions. * * * As a debugging step to make sure Import is working, I made a perl file, `get3numbers`, and tested on the Linux terminal:               $ ./get3numbers     11 22 33      Then I edited MBdebug.m to read `val = Import["! ./get3numbers", "Table"];` and ran MBresolveDebug. These 3 test numbers are set to val and Table.


What is taking so long in this simplification?

I killed this after 48 hours, it did not seem to be getting anywhere. In the best of all possible worlds it would spit out n!. If I put the summation in a function it does compute factorials (somewhat inconveniently) Mathematica 10 Linux Fedora 20 64-bit               Simplify[Sum[(1/(n - k)!) (Sum[       Sum[(-1)^(i + j) Binomial[k - 2 j, i] Binomial[k - i - 2 j + 1,           j] (n - i - 2 j)!, {i, 0, k - 3 j}], {j, 0,         k/3}] + (-1)^(k + 1) Sum[        Binomial[k - 2 j, k + 1 - 3 j] (n - k + j - 1)!, {j,          1, (k + 1)/3}]) , {k, 0, n}]]


Identifying the symbol which has a specific value

I'm writing a program that will solve the value of 1 variable in a 4-variable equality equation, but the variable to be solved will depend on the user's input to the program. This is what I've come up with: Create a _Mathematica_ script that reads in 4 parameters from the commandline. Read in the given 4 values and assign it to 4 variables. The variable that needs to be solved will have a specific value (say -100). I need to identify that variable and `Remove` it from the Mathematica namespace, so that 3 variables remain. I can then call the `Solve` function that contains n variables, but since I've used Remove on 1 of those, Mathematica solves the value for that variable. The only part that I don't get to work, is to identify which symbol's value is -100 so that I can call `Remove` on the symbol. Can anyone suggest a solution? I've tried putting all my variables in a list and find the symbol with value -100 using `Position` or `Case`, but it only returns the -100 numerical value and not the symbol name. As so:               (* Values for a, b, c and d have been read from the commandline using *)     (* a = ToExpression[$CommandLine[[4]]] etc  *)          list = {a, b, c, d}     (* {1, 2, 3, -100} *)          Position[list, -100]     (* {{4}} *)          Cases[list, -100]     (* {-100} *)          (* I can't call Remove on the answers given by Position and Cases to remove variable d *)      I've tried some other solutions as well but with no luck. In case it's relevant - I'm new to _Mathematica_.


Monotone, periodic 1d-interpolation with continuous 1st order derivative

Lately, we had this thread about interpolation where J. M. linked two interpolation methods. The background for my question is that I estimated a parameter in polar coordinates with dependence on the angle. Therefore, I have a set of values where I know that the values are periodic. **The question is:** Is there an easy procedure to interpolate a set of (only a few) points so that the interpolant is _monotonic, continuous up to the 1st order derivative, and where the continuous property holds between the start and the end of the interval_? I tried to tweak `Interpolation`, so if you are interested, please see the following section. ## Example and Investigation Let's define a simple dataset and use _Mathematica_ 's `Interpolation` with `PeriodicInterpolation -> True`:               data = {{0, 0.2}, {1/3, 0.9}, {2/3, 0.15}, {1, 0.2}};     ip = Interpolation[data, PeriodicInterpolation -> True]     Show[{           ListLinePlot[data, Mesh -> Full,                         MeshStyle -> Directive[Red, PointSize[0.02]]],           Plot[ip[x], {x, 0, 1}, PlotStyle -> ColorData[1, 2]]     }]      ![Mathematica graphics](http://i.stack.imgur.com/ljgqH.png) This does not look so bad at a first glance, but the minimum between the last two points violate the monotonicity (which was expected since the interpolation in _Mathematica_ never claimed such a property). Looking at the interpolation graph only and over the interval-boundary shows               Plot[ip[x], {x, 0.2, 1.2}]      ![Mathematica graphics](http://i.stack.imgur.com/dc0UI.png) that the derivative is not continuous. Now, my idea was that by using `PeriodicInterpolation -> True`, I basically tell _Mathematica_ that it can use the values periodically to pad the sides if required. Therefore, a higher interpolation order or maybe using `Method -> "Spline"` _should_ be able to make the derivatives continuous. When I try to use               Interpolation[data, PeriodicInterpolation -> True, Method -> "Spline"]      I get > Interpolation::mspl: The Spline method could not be used because the data > could not be coerced to machine real numbers. >> which I don't really understand. If I use `InterpolationOrder` and the default `"Hermite"` method, I need a value of 20 to get an _almost_ continuous derivative. Therefore, I tried to do the padding by myself and use `"Spline"` and a low interpolation order (to reduce the overshooting):               ip2 = Interpolation[       Join @@ Table[Plus[{i, 0}, #] & /@ Most[data], {i, 0, 10}],        InterpolationOrder -> 2, Method -> "Spline"]          Plot[{ip2[x]}, {x, 5, 6.5},           Epilog -> {Red, PointSize[0.02], Point[{5, 0} + # & /@ data]}]      ![Mathematica graphics](http://i.stack.imgur.com/sNV3T.png) which is of course not monotonic, but at least the derivative is continuous:               Plot[ip2'[x], {x, 5, 6.5}]      ![Mathematica graphics](http://i.stack.imgur.com/0ZKG0.png) ## Final solution I'm accepting the Steffen interpolation in J.M.'s answer as solution for the following reason: It shows nicely how one can supply derivative values and not only the interpolation values to `Interpolation`. It therefore does not implement a whole new interpolation but it only calculates adjusted derivatives and uses the internal `Interpolation` of _Mathematica_. Note, that I made some changes in his function. First, the following part               pp = Apply[Dot, Transpose[MapAt[Map[Reverse, #] &,       Map[Partition[#, 2, 1, {-1, 1}] &, {h, del}], 1]], 1]/       ListConvolve[{1, 1}, h, {1, -1}];      can be (IMO) slightly simplified to               pp = Dot @@@ Transpose[ MapAt[Reverse,        Map[Partition[#, 2, 1, {-1, 1}] &, {h, del}], {1, All}]]/       ListConvolve[{1, 1}, h, {1, -1}];      which saves a whole pure function and a `Map`. Otherwise, I combined the periodic and the non-periodic interpolation and added a pattern so that data in the form `{y1,y2,...}` can be interpolated in the usual way. (Please change the function name. It's only called like that since I included it in a package)               Options[IPCUMonotonicInterpolation] := {       PeriodicInterpolation -> False       }          steffenEnds[{{h1_, h2_}, {d1_, d2_}}] :=       With[{p = d1 + h1 (d1 - d2)/(h1 + h2)}, (Sign[p] + Sign[d1]) Min[         Abs[p]/2, Abs[d1]]]          IPCUMonotonicInterpolation[data_?(VectorQ[#, NumericQ] &), opts___?OptionQ] :=         IPCUMonotonicInterpolation[Transpose[{Range[Length[data]], data}], opts];          IPCUMonotonicInterpolation[data_?MatrixQ, OptionsPattern[]] :=        Module[{dTrans = Transpose[data], del, h, m, pp, optPeriodic, overhangs},       optPeriodic = OptionValue[PeriodicInterpolation];       h = Differences[First[dTrans]];        del = Differences[Last[dTrans]]/h;       overhangs = If[optPeriodic === False, {1, -1}, {-1, 1}];       (* Note that overhangs in Partition and ListConvolve are defined differently*)       pp = Dot @@@ Transpose[MapAt[Reverse,          Map[Partition[#, 2, 1, overhangs] &, {h, del}], {1, All}]]/         ListConvolve[{1, 1}, h, -1*overhangs];       If[optPeriodic === True,        del = ArrayPad[del, 1, "Periodic"]        ];       m = ListConvolve[{1, 1}, 2 UnitStep[del] - 1] *                     MapThread[Min, {Partition[Abs[del], 2, 1], Abs[pp]/2}];       Interpolation[        {{#1}, ##2} & @@@ Transpose[Append[dTrans,           If[optPeriodic === True,            m,            Flatten[{              steffenEnds[#[[{1, 2}]] & /@ {h, del}],              m,              steffenEnds[#[[{-1, -2}]] & /@ {h, del}]              }]            ]           ]],        PeriodicInterpolation -> optPeriodic]       ]


Does anyone know the options for "HierarchicalEdgeBundling" in Mathematica?

I'm looking to reproduce the types of graph layout that are possible in D3 (http://bl.ocks.org/mbostock/7607999) in Mathematica. Since Mathematica doesn't explicitly support force directed edge bundling, but does seem to support HierarchicalEdgeBundling (at least it's referred to once in the documentation) I wondered if anyone has had any success in doing something similar to the D3 visualisation linked above.


Another MoebiusMu question

When I evaluate the Mertens function to infinity:               NSum[MoebiusMu[k], {k, 1, \[Infinity]}]      I get -1, but I expected to get -2. I wanted to modify the function thus:               Unprotect[MoebiusMu];       MoebiusMu[1] := -1       Protect[MoebiusMu];        in order to get -2. But that gives me -3. So, why does `NSum` return -1.?


How can I set several Grids to have the same size?

I generate different `Grids` with different columns. Automatically `ImageSizes` are fixed depending upon the data. So every `Grid` has a different size.               grid1=Grid[{{Item["Name", Frame -> True, Background -> LightBlue, Alignment -> Left],                   Item["Branch", Frame -> True, Background -> LightBlue,Alignment -> Left],                   Item["Section", Frame -> True, Background -> LightBlue,Alignment -> Left]},                 {"s", "IT", "A"},                  {"u", "IT", "A"},                  {"b","IT", "A"},                  {"b", "IT", "A"},                 {"b", "IT", "A"}}, Frame -> True              ];           grid2=Grid[{{Item["Name", Frame -> True, Background -> LightBlue, Alignment -> Left],                   Item["Branch", Frame -> True, Background -> LightBlue,Alignment -> Left],                   Item["Section", Frame -> True, Background -> LightBlue,Alignment -> Left]},                 {"subrahmanyam", "IT", "A"},                  {"Madhu", "IT", "A"},                  {"Kiran","IT", "A"},                  {"KalyanKumar", "IT", "A"},                 {"Pavan", "IT", "A"}}, Frame -> True              ];       grid3 = Grid[{{"Main", SpanFromLeft, SpanFromLeft,       SpanFromLeft}, {Item["Name", Frame -> True,        Background -> LightBlue, Alignment -> Left],       Item["Branch", Frame -> True, Background -> LightBlue,        Alignment -> Left],       Item["Section", Frame -> True, Background -> LightBlue,        Alignment -> Left],       Item["Section", Frame -> True, Background -> LightBlue,        Alignment -> Left]}, {"subrahmanyam", "IT", "A", "g"}, {"Madhu",       "IT", "A"}, {"Kiran", "IT", "A"}, {"KalyanKumar", "IT",       "A"}, {"Pavan", "IT", "A"}}, Frame -> True,        ItemSize -> {{10, 7, 7, 7}, 1}];           finalGrid=Grid[{{grid3},{grid1}, {grid2}, {grid1}, {grid2}, {grid1}, {grid2}}]      grid1Image= ![enter image description here](http://i.stack.imgur.com/rhkWd.png) grid2Image= ![enter image description here](http://i.stack.imgur.com/AeTNM.png) grid3Image= ![enter image description here](http://i.stack.imgur.com/Pl1Mx.png) finalImage= ![enter image description here](http://i.stack.imgur.com/ENooy.png) If I place all the `Grids` columnwise within `Grid`, it doesn't look good. So, I want to fix all the `Grids` with the same sizes. I tried various things, but nothing seems to work. Can anybody help me?


Making a presentable BarChart

I've been asked to reproduce a bar chart generated in Excel in _Mathematica_. The original Excel chart looks like this; ![Excel chart](http://i.stack.imgur.com/Nfxs8.png) My _Mathematica_ version looks like this; ![Mathematica chart](http://i.stack.imgur.com/S90Mr.png) There are a couple of things wrong that I'd like to fix;   1. The `BarChart` and `ListPlot` overlay doesn't seem to match up.    2. The `ChartLabels` seem to have disappeared on the `BarChart`.   3. Is there a nice way to make the ticks on the left and right sides match up (like when the Excel chart matches 9 % on the left to 90 % on the right)?   4. I can't get the box and line to center align to the text in the legend. Questions 1 and 2 are what I really need to fix, but 3 and 4 would be nice to have. Any help would be appreciated. Here's the code I used to generate my chart;               purple = RGBColor[97/255, 16/255, 106/255];     orange = RGBColor[245/255, 132/255, 31/255];     labels =        {         "FY15 Q1/2", "FY15 Q3/4", "FY16 Q1/2", "FY16 Q3/4",          "FY17 Q1/Q2", "FY17 Q3/Q4", "FY18 Q1/2", "FY18 Q3/4"       };     starvedTime = {7.55, 11.23, 8.58333, 6.88833, 4.65167, 1.89, 6.49833, 1.95};     satTime = {70.1483, 81.1467, 81.115, 86.5483, 84.6833, 90.685, 79.6017, 91.0133};          plot1 = BarChart[starvedTime,        PlotRange -> {0, 12},        ChartStyle -> purple,        BaseStyle -> "Text",        Frame -> {True, True, True, False},       FrameTicks -> {False, True},        FrameLabel -> {None, Style["Smelter Starved Time (%)", "Text"], None, None},        PlotLabel -> "Smelter Starved Time by 6 Month Period: Base Case",        ImageSize -> Large,        ChartLabels -> {Placed[Style[#, "Text"] & /@ labels, Below], None},       AxesOrigin -> {0, 0},        PlotRangePadding -> {0, 0},        BarSpacing -> 1];          plot2 = ListPlot[satTime,       Joined -> True,       PlotRange -> {60, 100},       PlotStyle -> orange,       Frame -> {False, False, False, True},       FrameTicks -> {None, None, None, All},       FrameLabel ->        {None, None, None, Style["Smelter Operating at Constraint Rate (%)", "Text"]},       BaseStyle -> "Text",       GridLines -> {None, Automatic},       GridLinesStyle -> Directive[Gray, Dashed],      ImageSize -> Large];          box = Graphics[{purple, Rectangle[]}, ImageSize -> 12];     text = Style["   Smelter Starved (%)   ", "Text"];     line = Graphics[{orange, Line[{{0, 0.5}, {1, 0.5}}]}, ImageSize -> {30, Automatic}];     text2 = Text[Style["    % Time Smelter at Constraint Rate (%)       ", "Text"]];     legend = Row[{box, text, line, text2}];          Column[{Overlay[{plot1, plot2}], legend}, Alignment -> {Center, Center}]


How can I make a Plot over a discrete set of domain points?

I want to plot the function $y=2^x$ at the $x$-values given by `Table[Prime[n], {n,20}]` How should I write the plot function? Like so?               list = Table[Prime[n], {n,20}]     Plot[y = 2^x, Evaluate[list]]


X-Y scatterplot

Hi I have a simple question. How do I plot the following with Day 1 as my X axis and Day 2 as my Y axis? I need the 22 variances plotted according to the Day they were taken from (these were originally 3D measurements taken over 2 days with the same specimens each day, there were 11 specimens and 22 xyz measurements from which I have taken the variances). Can someone kindly help me out? I can't even find Scatterplot listed in Mathematica docs, do they call it something else?               {{{"ID", "Day", 1., 2., 3., 4., 5., 6., 7., 8., 9., 10., 11., 12.,      13., 14., 15., 16., 17., 18., 19., 20., 21., 22.}, {"H. sapiens",      1., 145.7, 153.2, 164.6, 161.1, 170.8, 191.7, 179.2, 178.5, 198.5,      169.9, 135.8, 182.8, 205.3, 210.3, 197.3, 238.4, 207.4, 209.,      188.6, 201.3, 210.2, 206.9}, {"H. sapiens", 2., 146.8, 152.7,      165.6, 165.1, 172.4, 189.2, 179.2, 193.9, 199.7, 172.9, 136.1,      181.8, 204.3, 212.3, 197.4, 238., 205.7, 211.5, 191.5, 204.3,      218.2, 204.2}, {"Pan troglodytes",      1., -200.9, -230.2, -205.5, -238.8, -237.3, -207.1, -213.2, \     -221.6, -225.9, -247.1, -242.6, -266.5, -259.1, -258., -266.1, -259., \     -227.3, -228.9, -212.1, -213.6, -223.9, -225.1}, {"Pan troglodytes",      2., -199.4, -229.6, -203.5, -243.6, -238.6, -205.7, -213.1, \     -222.3, -227.3, -258.1, -242.9, -265.4, -265.1, -258., -269.9, -260., \     -228.2, -233.3, -212.3, -215.1, -225.4, -223.6}, {"Pan verus ", 1.,      261.2, 273., 274., 283., 285.06, 300., 294., 305.037, 315.33,      289.08, 263.6, 298.46, 306.3, 316.7, 306.5, 331.6, 320.81, 323.7,      298.13, 312.79, 319.2, 310.2}, {"Pan verus", 2., 264.1, 268.7,      273.1, 289.19, 288.03, 299.9, 291.9, 304.137, 316.54, 289.675,      263.4, 298.58, 309.3, 316.2, 306., 332.3, 323.31, 327.4, 297.26,      310.95, 321.8, 310.9}, {"Pan schweinfurthii ", 1., 230.6, 241.2,      241., 257.3, 253.3, 274.1, 265.9, 272.36, 280.147, 259.21, 229.8,      268.19, 277.62, 286.6, 275.56, 306.3, 287.4, 292.04, 270.36,      283.35, 291.3, 281.13}, {"Pan schweinfurthii ", 2., 226.9, 237.9,      239.9, 254.6, 257., 273.7, 262., 273.33, 282.84, 260.05, 229.6,      267.49, 278.23, 287.9, 272.72, 306.2, 287.58, 287.92, 270.85,      283.37, 292.3, 281.88}, {"Pan paniscus ",      1., -421.9, -447., -420.9, -454.5, -451.7, -419.8, -427.8, -431.9, \     -445.7, -463.4, -459.2, -476.3, -470.1, -466.5, -475.5, -450.1, \     -439.5, -445.8, -417.4, -419.5, -434.4, -432.2}, {"Pan paniscus",      2., -426.2, -447.9, -421.5, -455.6, -453., -420.4, -428.7, -432.7, \     -441.5, -466.8, -459.5, -476.4, -470.9, -467.2, -474.7, -472.5, \      -437.5, -446.9, -416.4, -424.7, -433.1, -437.}, {"G. gorilla ",      1., -175.9, -204., -175.1, -221., -217., -168., -187., -198., \     -213., -229., -220.8, -251.8, -251., -245., -256., -243., -211., \     -224., -190., -194., -210., -212.}, {"G. gorilla ", 2., -180.8, -205.,     214.1, -228., -223., -167., -191., -195., -206., -242.9, -221.6, \     -251.8, -253., -243., -256., -243., -211., -224., -189.8, -196., \     -210., -215.}, {"G. graueri ", 1., 220., 192., 222., 177., 184., 228.,     214., 205., 187., 162., 174., 147., 155., 162., 145., 170., 194.,      186., 221.2, 215.5, 198.8, 198.3}, {"G. graueri ", 2., 221., 189.,      226., 182., 179., 230., 214., 210., 188., 161., 172., 146., 153.,      156., 146., 169., 193., 189., 221.2, 220.6, 202.2,      196.9}, {"G. beringei",      1., -763., -793.5, -762.2, -810.3, -802., -749.7, -771., -777., \     -783., -828., -809.3, -836.9, -833., -828., -837.9, -809., -788., \     -795., -767.3, -768.4, -789., -782.8}, {"G. beringei",      2., -763.3, -791.9, -761.3, -805.6, -800., -748.5, -769., -776., \     -774., -817.4, -812.8, -836.4, -833., -825., -837.2, -820., -791., \     -797., -766.6, -769.8, -782.6, -786.3}, {"G. diehli",      1., -78., -106.4, -77., -124., -121., -72.4, -87.5, -94., -99., \     -134., -122.1, -149., -153., -141., -154., -137., -105., -111., -83., \     -87., -104., -105.}, {"G. diehli",      2., -79.6, -105.8, -77., -124., -119., -72.1, -86., -100., -99., \     -134., -121.5, -148., -152., -142., -152., -135., -104., -110., \     -84.7, -86., -103., -107.}, {"P. abelii ",      1., -214.09, -232.6, -209.24, -232.56, -227.49, -185.5, -204.5, \     -209.5, -213.9, -250.52, -249.8, -256.49, -249.85, -244.22, -257.96, \     -237.6, -219.2, -225.2, -198.8, -201.9, -223.3, -224.2}, {"P. abelii \     ", 2., -214.93, -230.8, -209.97, -233.98, -230.51, -184.4, -204.4, \     -208.4, -214.1, -249.21, -250., -258.98, -250.1, -242., -256.86, \     -234.5, -225.9, -226.4, -201., -205.8, -225.1, -224.1}, {"P. \     pygmaeus",       1., -288.8, -280.5, -280.5, -265., -264., -238.5, -250.7, -234.2, \     -224.9, -258.9, -296.1, -259.5, -246.3, -234.5, -251.1, -212.5, \     -224.5, -219.6, -249.1, -230.4, -224.4, -233.}, {"P. pygmaeus",       2., -293.5, -284.3, -278.4, -256.8, -255.6, -236.3, -248.4, \     -233.4, -227.3, -261.4, -295.5, -262., -242.6, -233.8, -252.2, -212., \     -225.1, -220.3, -248.2, -230.9, -225.3, -233.7}}}


Creating lists from a string, separating words from numbers

Say I have a string that contains numbers and words, such as this one:               string = "there are 1234 words and numbers 5678 in here $999";      How would I separate the string into an ordered list containing sublists populated with words and numbers? The ideal list would look like this:               idealList = {{there are}, {1234}, {words and numbers}, {5678}, {in here}, {$999}}      I know how to extract all words and all numbers, but I can't create a list like the previous one. * * * Here's an example of what I tried to extract words and its output:               StringCases[string, RegularExpression["\\w(?<!\\d)[\\w'-]*"]]     {there, are, words, and, numbers, in, here}      I can also do this with pattern-matching instead of RegEx, but it doesn't get me closer to my goal. Is my regex simply wrong, or does this problem require a tiny bit more involved solution?


Defining functions that reference other values

How could I define a function that references other values? eg               a = 2 x; b = 4 k;     f[k_, x_] := a^b


Reduce data by taking averages

I am trying to implement the following: I have got two vectors `x` and `y` of unequal lengths. The length of `y` is much larger than `x`. I want to define a new `y` such that its length will be equal to the length of `x` by taking appropriate averages of the elements in `y`. For example, if `y` includes 200 elements and `x` 100 elements, then I would define a new `y` such that `y` will be the average of every subsequent two elements in `y`.


What is missing in this Mathematica Journal Article?

So I had been looking to solve a little tiling problem and Google turned up this Mathematica Journal Article and I noticed the code was both incomplete and incorrect, so... My Question is, What is missing to make this code actually work? To make this process slightly less time consuming, Here's a rough interpretation of the journal post in actual code form. Some things were changed that were obvious errors like undeclared variables and punctuation. Also there were functions inside of functions, and where it was clear (to me) that method was wrong, they were moved.               lexic[p_] := Sort[p, (Im[#1] < Im[#2]) || ((Im[#1] == Im[#2]) && (Re[#1] <= Re[#2])) &];          tess[{n_, m_}, poly_, justOneSolution_: False] := Module[{avail, pieces, i, j, ans = {}, tessAux, na, ma},tessAux[partial_] := Module[{f, c, candidates, newp, k},     candidates = Complement[avail, Flatten@partial];     If[candidates == {},     AppendTo[ans, partial]; If[justOneSolution, Throw[1]],     k = First@lexic@candidates;     Map[(newp = k + # - First[#];      If[(Complement[newp, avail] == {}) && (f =           Flatten[{partial, newp}];         Length@f == Length@Union@f),        tessAux[Append[partial, newp]]]) &, pieces]]];     {na, ma} = If[n < m, {m, n}, {n, m}];     pieces = lexic /@ Union[Flatten[pieces /@ poly, i]];     avail = Flatten[Table[i + j*i, {j, 0, na - i}, {i, 0, ma - 1}]];     Catch[tessAux[{}];     If[n < m, Map[m - 1 + i # &, ans], ans]];          getLines[tiling_] := Module[{p},     Partition[Flatten[Map[(p = #;      Map[{If[Not[MemberQ[p, # + 1]], {# + 1 + i}, {}],     If[Not[MemberQ[p, # + i]], {# + i, # + 1 + i}, {}]} &, p]) &, tiling]], 2]];          tile[{n_, m_}, poly_, r_, justOneSolution_: False] := Module[{t, u, g},     t = tess[{n, m}, poly, justOneSolution];     g = Map[Graphics[Append[{{LightBlue, Rectangle[{0, 0}, {m, n}]},     Line[{{0, n}, {0, 0}, {m, 0}}]},     lexic /@ getLines[#]]] &, t];     Show[GraphicsArray[Partition[If[Mod[Length[t], r] == 0, g,          Join[g,Table[Graphics[Point[{0, 0}]], {r - Mod[Length[t], r]}]]], r]]]      ]


Plot above desired region

I would like to plot a real-valued function $f$ of two real variables $x,y$ but only over the region of the $x$-$y$ plane satisfying \begin{align} x>0, \qquad -x^{3/2} < y < x^{3/2}. \end{align} Is there a straightforward way to do this using Plot3D?


How to do color-fill in Mathematica?

`Color fill`, the ability to apply a desired color to an enclosed area, is one of the basic functions provided by most graphic applications. Is there a similar function provided in Mathematica? For example, how to obtain a _red_ , _green_ , _blue_ and _yellow_ horses silhouette from the picture below in Mathematica?               im = Import["http://i.stack.imgur.com/ZDeYq.jpg"]     ReplacePixelValue[im, {924, 221} -> Blue]      `ReplacePixelValue` seems only work on one pixel only. `Colorize` seems provide no controls on obtaining a specific color. `ColorReplace` seems only work on a bundle of the same color all together . ![enter image description here](http://i.stack.imgur.com/HSmRb.gif)


How can I transfer mathematical expressions between Mathematica and Maple?

Is there a simple way to copy mathematical expressions between _Mathematica_ and _Maple_ (or at least in one direction)? I mean only expressions built from numbers and predefined mathematical functions, whithout any patterns or programmatical constructs like `Function`, `Map` or `Nest`. Ideally, I want functions with different definitions to be automatically adjusted, for example the _Mathematica_ expression `EllipticF[Pi/6, 1/4]` should be converted to the _Maple_ expression `EllipticF(1/2, 1/2)`.


Programmatically generate packages from notebook files?

Currently, there are two ways I know of to generate a package (.m) file from a notebook file; one is to set the `AutoGeneratedPackage` option in the Option Inspector, and the other is to use the menu optoin to "Save as" a package. The first doesn't really suit my needs because it creates the auto-generated packages in the same directory as the notebook file, which clutters things up (there are dozens of notebooks in this directory) and adds a needless complication to keeping the set-up version controlled. The second option is less than ideal because I don't know how to invoke the option programmatically. In theory, I know it might be possible with `FrontEnd` commands, but I'd really prefer to be able to do this without a front end if at all possible. This is something I want to do from GNU `make`, and while I know you can now set up front ends from the command line, ideally I could avoid that.


HITS centrality

I want the centrality measure of a particular vertex in my graph, and for Closeness, Betweenness and Degree centralities I have been using :               Pick[bc, VertexList[graph1], 1 ]      However, for `HITSCentrality`, the result is in two lists, and I'm not sure how to pick out the two values for a single node. Something like this isn't working...               Pick[bc, VertexList[graph1], {1,1} ]


Why are reference lines missing in ProbabilityScalePlot when using Show?

failurevalues1 = {21, 19., 23., 22., 20., 28., 25.};     failurevalues2 = {30., 28., 28., 29., 31., 28., 30.};     failurevalues3 = {344., 552., 326., 267., 382., 301., 354.};          plot1 = ProbabilityScalePlot[failurevalues1, "LogNormal",      PlotRange -> {{10, 1000}, {1, 99}}, PlotStyle -> Red, Frame -> True,     FrameLabel -> {"Number of Cycles", "CDF"}, PlotLabel -> "Plot 1"]          plot2 = ProbabilityScalePlot[failurevalues2, "LogNormal",      PlotRange -> {{10, 1000}, {1, 99}}, PlotStyle -> Black,      Frame -> True, FrameLabel -> {"Number of Cycles", "CDF"},      PlotLabel -> "Plot 2"]          plot3 = ProbabilityScalePlot[failurevalues3, "LogNormal",      PlotRange -> {{10, 1000}, {1, 99}}, PlotStyle -> Blue,      Frame -> True, FrameLabel -> {"Number of Cycles", "CDF"},      PlotLabel -> "Plot 3"]      > ![Plot1](http://i.stack.imgur.com/iXzkt.png) > ![Plot2](http://i.stack.imgur.com/ayKmY.png) > ![Plot3](http://i.stack.imgur.com/Zc8ge.png) So far, so good. The individual plots look reasonable.               plot4 = Show[plot1, plot2, plot3, PlotLabel -> "Plot Comparison"]      > ![Plot](http://i.stack.imgur.com/aQPEs.png) Here is the problem, why is only 1 reference line shown in plot4 ? How can I display the 2 missing reference lines ?


To solve Cylinderical PDE

![](http://i.stack.imgur.com/a1tAv.jpg) I want to solve this PDE. I have tried to solve it with `NDSolve` but found error 'Boundary values may only be specified for one independent variable. Initial values may only be specified at one value of the other independent'. Please help me to solve this problem: I am beginner in Mathematica. This is cylinderical PDE and in equation omega, lambda and fi have constant values i.e 2,3,4 This is what I have tried.               sol = NDSolve[{w^2 (1/p) (D[T[p, x] (D[T[p, x], {p, 1}]), {p, 1}])            + D[T[p, x], {x, 2}] - 2 l (D[T[p, x], {x, 1}]) - 4 f^2 (T[p, x]) == 0,     T[p, 0] == 1, T[p, 1] == 1, T[0, x] == 10, T[1, x] == 1},      {T[p, x]}, {p, 0, 1}, {x, 0, 1}]


How to write a function-defining function which stores the function arguments in a stack?

I have a function-defining function               SetAttributes[DefFn, HoldAll];          DefFn[f_[args___], body_] :=      f[args] := body;      I am trying to modify this function to record the function name and the values of its arguments on a stack for error-reporting purposes. I have a function `WithStackFrame` which adds this information to a list, and I am inserting a call to this function into each definition:               DefFn[f_[args___], body_] :=      f[args] := WithStackFrame[f,body];      This allows me to give a stack backtrace when reporting errors. This works. The problem comes when I try to store also the values of the function arguments. A naive               DefFn[f_[args___], body_] :=      f[args] := WithStackFrame[{f,{args}},body];      does not work because `args` is actually the sequence of patterns. The closest I have got is               DefFn[f_[args___], body_] :=      Module[{argValueExprs,x},         argValueExprs = {args} /. x_Pattern :> x[[1]];         f[args] := WithStackFrame[{f,argValueExprs},body]];      For the purpose of testing, you can use               WithStackFrame[sf_, expr_] := Print[sf];      However, running this gives               DefFn[f[x_], x^2];          f[3]       (*     {f,{x}}     *)      when I really want `{f,{3}}`. For some reason, the `x` is not being evaluated in a scope in which the function arguments are visible.


How to ListPlot over an Imported Image

I would like to plot the gray scale (average of RGB) of an imported image, and combine the graph with the imported image. How can I do that in Mathematica? Say, the imported image is a 800x5-pixel image. 800 pixels in the horizontal, and 5 pixels in the vertical. I would like to plot the gray scale (average of RGB) of the image across the horizontal direction, and put it on top of the image to provide the visualization of the image plus the gray scale change along the horizontal direction. Thanks for the help!


Dsolve too slow -- is there anyway around?

I am trying to solve:               DSolve[{Cn'[t] == CP[t]*kr - P*Cn[t]*kf,              CP'[t] == Cn[t]*P*kf + 2*CPP[t]*kr - P*CP[t]*kf - CP[t]*kr,              CPP'[t] == CP[t]*P*kf + 3*CPPP[t]*kr - P*CPP[t]*kf - 2*CPP[t]*kr,              CPPP'[t] == CPP[t]*P*kf + 4*CPPPP[t]*kr - P*CPPP[t]*kf - 3*CPPP[t]*kr,              CPPPP'[t] == CPPP[t]*P*kf - 4*CPPPP[t]*kr, CP[0] == 0, CPP[0] == 0,              CPPP[0] == 0, CPPPP[0] == Chp, Cn[0] == Chn},            {Cn[t], CP[t], CPP[t], CPPP[t], CPPPP[t]}, t]      _Mathematica_ 9 did not give a result overnight and ate up all the memory (~6g). However it can solve               DSolve[{Cn'[t] == CP[t]*kr - P*Cn[t]*kf,              CP'[t] == Cn[t]*P*kf + CPP[t]*kr - P*CP[t]*kf - CP[t]*kr,              CPP'[t] == CP[t]*P*kf + CPPP[t]*kr - P*CPP[t]*kf - CPP[t]*kr,              CPPP'[t] == CPP[t]*P*kf + CPPPP[t]*kr - P*CPPP[t]*kf - CPPP[t]*kr,              CPPPP'[t] == CPPP[t]*P*kf - CPPPP[t]*kr, CP[0] == 0, CPP[0] == 0,              CPPP[0] == 0, CPPPP[0] == chp, Cn[0] == chn},           {Cn[t], CP[t], CPP[t], CPPP[t], CPPPP[t]}, t]      in hours. I am not very familiar with _Mathematica_. I wonder if there is a way to solve this system (the former one).


Spherical density plot of data set

I have a somewhat large number of 3-dimensional unit vectors ( ~ 100 000 unit vectors), and I am trying to visualize their distribution. First thing I tried was `ListPlot3D`, but it doesn't look too good. Now, I would like to make a density plot on the surface of the unit sphere using this data. For example, the sphere would be bluish in the regions with little or no points, and reddish in regions with many points (you can use any colors you want). Can I do this with _Mathematica_?


Nested NIntegrate problem

So I've been trying to evaluate the following integral in Mathematica 8.0 Student version:               opsnum[a_, \[Omega]_] := (c^5*(3*10^25))/\[HBar]*           NIntegrate[\[Rho][y, \[Omega]]/             Hubble[y, \[Omega]]*(1/Hubble[z, \[Omega]])^3, {y,              a, \[Infinity]}, {z, a, y}]      with                   Hubble[z_, \[Omega]_] :=       H0 Sqrt[\[CapitalOmega]M (1 + z)^3 + \[CapitalOmega]\[Gamma] (1 +            z)^4 + \[CapitalOmega]\[CapitalLambda] ((1 +             z)^(3*(1 + \[Omega])))]          \[Chi][a_, \[Omega]_] :=       NIntegrate[c/Hubble[z, \[Omega]], {z, a, \[Infinity]}]     \[Rho][a_, \[Omega]_] := (3*Matter[a, \[Omega]])/(      4 \[Pi]*(\[Chi][a, \[Omega]])^3)      My problem is that this refuses to converge, and gives me an `NIntegrate::inumr` error, due to the nested integral nature of the function. Furthermore, I cannot think of another definition for the function as it relies on the cube of an integral which has limits different from the limits of the total integrand, of which it is a part. Anyone got any ideas? I would be eternally grateful!


Solving a dynamic program via recursion

I'm trying to use recursion to solve a joint inventory/ dynamic pricing problem as in monahan, petruzzi and zhao 2004. I tried to solve for `y[t]` and `k[t]` via recursion with the following code:               m = 0.5;     λ = 0.1;     k[0] = 0;     y[0] = 0;     Clear[y];     Clear[k];     r[t_Integer, z_] :=        1/z^m (-(1/λ)*E^(-λ*z) + 1/λ + k[t - 1]*λ*Integrate[(z - w)^m*E^(-λ*w), {w, 0, z}]) // N;     y[t_Integer] := y[t] = ArgMax[{r[t, j], j > y[t - 1]}, j] // N;     k[t_Integer] := k[t] = r[t, y[t]];     y[1]      I get the following message: > $RecursionLimit::reclim: Recursion depth of 1024 exceeded. >> When I solve the problem manually, it works fine:               b = 2;     m = 1 - 1/b;     λ = 1/187;     r1[z_] := 1/z^m (-(1/λ)*E^(-λ*z) + 1/λ ) // N;     y1 = ArgMax[{r1[g], g >= 0}, g];     y1     r1[y1]      > >     234.953 >     8.72688 >                 r2[z_] :=        N[(1/z^m)*(-(1/λ)/E^(λ*z) + 1/λ + r1[y1]*λ*Integrate[(z - w)^m/E^(λ*w), {w, 0, z}])];     y2 = ArgMax[{r2[h], h >= y1}, h];     y2     r2[y2]      > >     486.281 >     14.432 >                 r3[z_] :=        N[(1/z^m)*(-(1/λ)/E^(λ*z) + 1/λ + r2[y2]*λ*Integrate[(z - w)^m/E^(λ*w), {w, 0, z}])];     y3 = ArgMax[{r3[i], i >= y2}, i];     y3     r3[y3]      > >     687.782 >     18.982 >                 ...      Could anybody tell me where's my mistake? This is the updated code, after editing the suggestions:               m = 0.5;     \[Lambda] = 1/187;     r[0, z_] := 0;     Clear[k, y];     k[0] = 0;     y[0] = 0;     r[t_Integer, z_] :=        1/z^m (-(1/\[Lambda])  Exp[-\[Lambda] z] + 1/\[Lambda] +            k[t - 1] \[Lambda] Integrate[(z - w)^m Exp[-\[Lambda] z], {w, 0,               z}]) // N;     y[t_Integer] := y[t] = ArgMax[{r[t, j], j > y[t - 1]}, j] // N;     k[t_Integer] := k[t] = r[t, y[t]];     y[1]     k[1]     y[3]     k[3]          234.953          8.72688          234.953          11.3039


WeatherData function problem: "NonMetricValue" returns undated list of values

In the WL example below, `WeatherData[]` returns an undated list of values when I add the annotation "NonMetricValue."               WeatherData["New York City", "MeanTemperature", {{2013,12,1},{2013,12,12},"Day"}]      > {{{2013,12,1},5.5},{{2013,12,2},6.06},{{2013,12,3},4.94},{{2013,12,4},6.5}, > {{2013,12,5},9.17},{{2013,12,6},11.56},{{2013,12,7},3.22},{{2013,12,8},0.11}, > {{2013,12,9},0.22},{{2013,12,10},2.22},{{2013,12,11},-0.72}, > {{2013,12,12},-1.22}}               WeatherData["New York City", "MeanTemperature",           {{2013,12,1},{2013,12,12},"Day"}, "NonMetricValue"]      > {41.9,42.91,40.89,43.7,48.51,52.81,37.8,32.2,32.4,36.,30.7,29.8} This seems like a bug, since a proper effect would change only the values. Aside from that, is this a syntax problem (am I doing it wrong)? I would like to be able to get a date list of temperature in Fahrenheit directly from `WeatherData[]`.


Linear Solve with Modular Arithmetic

I am interested in using `LinearSolve[m,b]` which will find a solution to the equation $m.x=b$, where I am in mod 2 arithmetic. Is there any way to perform this computation in _Mathematica_ ?


Internal Shooting Method of NDSolve in combination with NDSolve`Reinitialize?

To explain my problem, I am trying to extend the BVP problem example from the help that illustrates how to use the shooting method of NDSolve:               sols = First[NDSolve[{x''[t] + Sin[x[t]] == 0, x[0] == x[10] == 0}, x, t,      Method -> {"Shooting", "StartingInitialConditions" -> {x[0] == 0, x'[0] == 1.75}}]];      Plot[Evaluate[x[t] /. sols], {t, 0, 10}]      ![The solution is fine so far.](http://i.stack.imgur.com/39T5u.png) I managed to split up the problem as following:               ndssdata = First[NDSolve`ProcessEquations[{x''[t] + Sin[x[t]] == 0, x[0] == 0, x[10] == 0}, x, t, Method -> {"Shooting", "StartingInitialConditions" -> {x[0] == 0, x'[0] == 1.75}}]]          NDSolve`Iterate[ndssdata, 10]; ndsol1 = NDSolve`ProcessSolutions[ndssdata]; Plot[Evaluate[x[t] /. ndsol1], {t, 0, 10}]      The solution is the same and everything works as expected: However, when I try to change the boundary conditions with NDSolve`Reinitialize it complains about a restriction that initial conditions should be specified at a single point, which does not make sense for a BVP:               newstate = First[NDSolve`Reinitialize[ndssdata, {x[0] == 0, x[10] == 1}]]           NDSolve`Reinitialize::ndcinit: Initial conditions should be specified at a single point.      I was hoping to speed up my problem, in which I plan solving the same set of equations with the internal shooting method many times with varying boundary conditions. I know how to do it with my own FindRoot shooting approach, but this would be more elegant. Does anyone know how to do this?


Problems with importing a .txt file

I have some problems with importing a .txt file as a table. This is the file. I tried importing it with               data = Import["data.txt", "Data"]       I want to access single values, but it doesn't work with my import. I can't access `data[[2, 1]]` for example to get the first value in `data[[2]]` and so on. Any ideas?


Different behaviour of ValueQ inside and outside of a loop

I need to store a rather big number of variables and I tried to do that by storing each variable as Z[n] with varying n. I guess this was not my best idea. The first problem I encountered is when I tried to check whether Z[n] is set. As you can see at the picture if I do this inside a loop it is always true and outside a loop it is the correct value. Why is this happening? I have mathematica 8.0.4.0. (I had no idea how should I have tagged the question. Feel free to change them.) ![Output](http://i.stack.imgur.com/VwiAn.gif)


Total Variation Distance of probability matrix

How can I calculate the Total Variation Distance of a transition Matrix? is there any built in function? I've searched all documentation and haven;t found anything. ** More information: Let me try to explain it better. let's say we have a transition matrix (P), 4x4 that describes the probability of going from a, b, c and d to a, b, c or d in 1 step. We can calculate the stationary distribution of P, and that's called Pi in the following equation, and Pyx is the probability of going from state y to state x (a,b,c,d): ![enter image description here](http://i.stack.imgur.com/DtxLN.png) What I want to do is calculate the Total Variation Distance of P from Pi after n-steps and starting on a given state. _*_ This is what I have so far: > M = {{0.3, 0, 0.5, 0.2}, {0, 0.4, 0.3, 0.3}, {0.3, 0.2, 0, 0.5}, {0.4, 0.1, > 0, 0.5}} > > B = Transpose[M] > > N[B] // MatrixForm > > {eVals, eVecs} = Eigensystem[B] > > eVals // MatrixForm > > eVecs // MatrixForm > > eigenvector = eVecs[[1]] > > Print["Stationary Distribution"]; > > eigenvector/Total[eigenvector] > > Print["M after 1 step"]; > > M2 = MatrixPower[M, 2]