NonlinearModelFit::cvmit: Failed to converge to the requested accuracy or precision within 100 iterations

I have got a problem in my program with NonlinearModelFit:               datan = Take[data, {1, 350}, {1, 1}];     mn =  939.565;          hbarc = 2*(197.33)^2;          datak = Sqrt[mn*datan/hbarc];          datadephasage = Take[data, {1, 350}, {2, 2}];          datanew = Join[datak, datadephasage, 2]          nlm1 = NonlinearModelFit[datanew, ((-ArcTan[x/a]*180/Pi) - (ArcTan[x/b]*180/Pi) -(ArcTan[x/c]*180/Pi) - (ArcTan[x/d]*180/Pi) - (ArcTan[x/e]*180/Pi)), {a, b, c, d, e}, x];      I get the error in the title of my post. If you wan to test my values,               datanew = {{0., 0.}, {0.0109839, 14.551}, {0.0155335, 20.5526}, {0.0190246,        23.7734}, {0.0219677, 26.9133}, {0.0245607, 29.7561}, {0.0269049,        32.0505}, {0.0290606, 33.9131}, {0.0310671, 35.5476}, {0.0329516,        37.0554}, {0.034734, 38.4352}, {0.0364294, 39.6848}, {0.0380492,        40.8166}, {0.0396029, 41.8463}, {0.0410979, 42.7896}, {0.0425403,        43.6624}, {0.0439355, 44.4783}, {0.0452876, 45.2432}, {0.0466006,        45.9605}, {0.0478776, 46.6338}, {0.0491214, 47.2669}, {0.0503344,        47.8631}, {0.0515189, 48.4255}, {0.0526768, 48.9567}, {0.0538097,        49.4595}, {0.0549193, 49.9368}, {0.056007, 50.3911}, {0.0570739,        50.8239}, {0.0581212, 51.2366}, {0.0591499, 51.6305}, {0.0601611,        52.0069}, {0.0611556, 52.3671}, {0.0621341, 52.712}, {0.0630975,        53.0425}, {0.0640464, 53.3596}, {0.0649814, 53.6641}, {0.0659032,        53.9569}, {0.0668123, 54.2386}, {0.0677091, 54.5098}, {0.0685942,        54.771}, {0.0694681, 55.0228}, {0.0703311, 55.2658}, {0.0711836,        55.5003}, {0.072026, 55.7268}, {0.0728587, 55.9457}, {0.073682,        56.1574}, {0.0744962, 56.3622}, {0.0753016, 56.5605}, {0.0760985,        56.7525}, {0.0768871, 56.9385}, {0.0776677, 57.1188}, {0.0784405,        57.2937}, {0.0792058, 57.4634}, {0.0799638, 57.6281}, {0.0807146,        57.788}, {0.0814585, 57.9434}, {0.0821957, 58.0943}, {0.0829264,        58.241}, {0.0836506, 58.3837}, {0.0843687, 58.5225}, {0.0850807,        58.6575}, {0.0857868, 58.7889}, {0.0864871, 58.9168}, {0.0871817,        59.0414}, {0.0878709, 59.1628}, {0.0885548, 59.2811}, {0.0892334,        59.3964}, {0.0899068, 59.5088}, {0.0905753, 59.6183}, {0.0912389,        59.7252}, {0.0918976, 59.8295}, {0.0925517, 59.9313}, {0.0932012,        60.0306}, {0.0938462, 60.1276}, {0.0944868, 60.2222}, {0.0951231,        60.3147}, {0.0957551, 60.405}, {0.096383, 60.4933}, {0.0970069,        60.5795}, {0.0976268, 60.6638}, {0.0982427, 60.7462}, {0.0988548,        60.8267}, {0.0994632, 60.9055}, {0.100068, 60.9825}, {0.100669,        61.0579}, {0.101266, 61.1316}, {0.10186, 61.2037}, {0.102451,        61.2743}, {0.103038, 61.3434}, {0.103622, 61.411}, {0.104202,        61.4772}, {0.104779, 61.542}, {0.105354, 61.6054}, {0.105925,        61.6676}, {0.106493, 61.7285}, {0.107058, 61.7881}, {0.107619,        61.8465}, {0.108179, 61.9037}, {0.108735, 61.9598}, {0.109288,        62.0148}, {0.109839, 62.0686}, {0.110387, 62.1214}, {0.110932,        62.1732}, {0.111474, 62.2239}, {0.112014, 62.2737}, {0.112551,        62.3224}, {0.113086, 62.3703}, {0.113618, 62.4171}, {0.114148,        62.4631}, {0.114675, 62.5082}, {0.1152, 62.5525}, {0.115722,        62.5959}, {0.116242, 62.6384}, {0.11676, 62.6802}, {0.117276,        62.7212}, {0.117789, 62.7614}, {0.1183, 62.8008}, {0.118809,        62.8395}, {0.119315, 62.8775}, {0.11982, 62.9148}, {0.120322,        62.9514}, {0.120823, 62.9873}, {0.121321, 63.0226}, {0.121817,        63.0572}, {0.122311, 63.0911}, {0.122803, 63.1245}, {0.123294,        63.1572}, {0.123782, 63.1893}, {0.124268, 63.2209}, {0.124753,        63.2518}, {0.125235, 63.2822}, {0.125716, 63.3121}, {0.126195,        63.3414}, {0.126672, 63.3702}, {0.127147, 63.3984}, {0.127621,        63.4262}, {0.128093, 63.4534}, {0.128563, 63.4802}, {0.129031,        63.5064}, {0.129498, 63.5322}, {0.129963, 63.5575}, {0.130426,        63.5824}, {0.130888, 63.6068}, {0.131348, 63.6308}, {0.131806,        63.6544}, {0.132263, 63.6775}, {0.132719, 63.7002}, {0.133172,        63.7225}, {0.133625, 63.7444}, {0.134075, 63.7659}, {0.134524,        63.787}, {0.134972, 63.8078}, {0.135418, 63.8281}, {0.135863,        63.8481}, {0.136306, 63.8677}, {0.136748, 63.887}, {0.137188,        63.9059}, {0.137627, 63.9245}, {0.138065, 63.9428}, {0.138501,        63.9607}, {0.138936, 63.9783}, {0.13937, 63.9955}, {0.139802,        64.0125}, {0.140233, 64.0291}, {0.140662, 64.0454}, {0.14109,        64.0615}, {0.141517, 64.0772}, {0.141943, 64.0926}, {0.142367,        64.1078}, {0.14279, 64.1227}, {0.143212, 64.1372}, {0.143633,        64.1516}, {0.144052, 64.1656}, {0.14447, 64.1794}, {0.144887,        64.1929}, {0.145303, 64.2062}, {0.145717, 64.2192}, {0.146131,        64.232}, {0.146543, 64.2445}, {0.146954, 64.2568}, {0.147364,        64.2688}, {0.147773, 64.2806}, {0.14818, 64.2922}, {0.148587,        64.3036}, {0.148992, 64.3147}, {0.149397, 64.3256}, {0.1498,        64.3363}, {0.150202, 64.3468}, {0.150603, 64.357}, {0.151003,        64.3671}, {0.151402, 64.3769}, {0.1518, 64.3866}, {0.152197,        64.396}, {0.152593, 64.4053}, {0.152988, 64.4143}, {0.153381,        64.4232}, {0.153774, 64.4319}, {0.154166, 64.4404}, {0.154557,        64.4487}, {0.154947, 64.4568}, {0.155335, 64.4648}, {0.155723,        64.4725}, {0.15611, 64.4801}, {0.156496, 64.4876}, {0.156881,        64.4948}, {0.157265, 64.5019}, {0.157648, 64.5089}, {0.15803,        64.5157}, {0.158412, 64.5223}, {0.158792, 64.5287}, {0.159171,        64.535}, {0.15955, 64.5412}, {0.159928, 64.5472}, {0.160304,        64.553}, {0.16068, 64.5587}, {0.161055, 64.5643}, {0.161429,        64.5697}, {0.161802, 64.575}, {0.162175, 64.5801}, {0.162546,        64.5851}, {0.162917, 64.59}, {0.163287, 64.5947}, {0.163656,        64.5993}, {0.164024, 64.6038}, {0.164391, 64.6081}, {0.164758,        64.6123}, {0.165124, 64.6164}, {0.165489, 64.6203}, {0.165853,        64.6242}, {0.166216, 64.6279}, {0.166579, 64.6315}, {0.16694,        64.635}, {0.167301, 64.6383}, {0.167661, 64.6416}, {0.168021,        64.6447}, {0.16838, 64.6477}, {0.168737, 64.6506}, {0.169094,        64.6534}, {0.169451, 64.6561}, {0.169806, 64.6587}, {0.170161,        64.6612}, {0.170515, 64.6635}, {0.170869, 64.6658}, {0.171222,        64.668}, {0.171574, 64.67}, {0.171925, 64.672}, {0.172275,        64.6739}, {0.172625, 64.6756}, {0.172974, 64.6773}, {0.173323,        64.6789}, {0.17367, 64.6804}, {0.174017, 64.6818}, {0.174363,        64.6831}, {0.174709, 64.6843}, {0.175054, 64.6854}, {0.175398,        64.6864}, {0.175742, 64.6874}, {0.176085, 64.6883}, {0.176427,        64.689}, {0.176769, 64.6897}, {0.17711, 64.6903}, {0.17745,        64.6908}, {0.177789, 64.6913}, {0.178128, 64.6916}, {0.178467,        64.6919}, {0.178804, 64.6921}, {0.179141, 64.6923}, {0.179478,        64.6923}, {0.179814, 64.6923}, {0.180149, 64.6922}, {0.180483,        64.692}, {0.180817, 64.6917}, {0.181151, 64.6914}, {0.181483,        64.691}, {0.181815, 64.6906}, {0.182147, 64.69}, {0.182478,        64.6894}, {0.182808, 64.6887}, {0.183138, 64.688}, {0.183467,        64.6872}, {0.183795, 64.6863}, {0.184123, 64.6854}, {0.184451,        64.6844}, {0.184777, 64.6833}, {0.185103, 64.6821}, {0.185429,        64.6809}, {0.185754, 64.6797}, {0.186079, 64.6783}, {0.186402,        64.677}, {0.186726, 64.6755}, {0.187049, 64.674}, {0.187371,        64.6724}, {0.187692, 64.6708}, {0.188014, 64.6691}, {0.188334,        64.6674}, {0.188654, 64.6656}, {0.188974, 64.6637}, {0.189293,        64.6618}, {0.189611, 64.6599}, {0.189929, 64.6579}, {0.190246,        64.6558}, {0.190563, 64.6537}, {0.190879, 64.6515}, {0.191195,        64.6492}, {0.19151, 64.647}, {0.191825, 64.6446}, {0.192139,        64.6423}, {0.192453, 64.6398}, {0.192766, 64.6373}, {0.193079,        64.6348}, {0.193391, 64.6322}, {0.193703, 64.6296}, {0.194014,        64.6269}, {0.194324, 64.6242}, {0.194635, 64.6214}, {0.194944,        64.6186}, {0.195254, 64.6158}, {0.195562, 64.6128}, {0.19587,        64.6099}, {0.196178, 64.6069}, {0.196485, 64.6039}, {0.196792,        64.6008}, {0.197098, 64.5977}, {0.197404, 64.5945}, {0.19771,        64.5913}, {0.198014, 64.588}, {0.198319, 64.5847}, {0.198623,        64.5814}, {0.198926, 64.578}, {0.199229, 64.5746}, {0.199532,        64.5712}, {0.199834, 64.5677}, {0.200136, 64.5641}, {0.200437,        64.5606}, {0.200738, 64.557}, {0.201038, 64.5533}, {0.201338,        64.5496}, {0.201637, 64.5459}, {0.201936, 64.5421}, {0.202234,        64.5384}, {0.202533, 64.5345}, {0.20283, 64.5307}, {0.203127,        64.5268}, {0.203424, 64.5228}, {0.20372, 64.5189}, {0.204016,        64.5149}, {0.204312, 64.5108}, {0.204607, 64.5067}, {0.204901,        64.5026}, {0.205196, 64.4985}}      I know from Matlab (another program) that some good parameter {a, b, c, d, e} I search with the "NonlinearModelFit tool" are {-0.04,-0.75,4.16,0.61,2.04}. But can you please tell me why I cannot find something in _Mathematica_? Thank you for your time and sorry for my bad english :) Like this               nlm2 = NonlinearModelFit[     datanew, -(ArcTan[x/a] + ArcTan[x/b] + ArcTan[x/c] + ArcTan[x/d] +      ArcTan[x/e]) 180/Pi, {a, {b, 2.04}, {c, -0.043717}, d, e}, x]      And then like this               nlm2[{ "BestFit", "BestFitParameters", "ParameterTable", "RSquared",      "AdjustedRSquared", "AIC", "BIC"}]      the section BestFitParameters of the output give me good results. but it is because I knew some values (2.04 and -0.04) before from MATLAB so how can I do this with only Mathematica?


Derive a PDE from other PDEs

I'm trying to do some symbolic calculation like this: > Substitute (11.2) into the last two of equations (11.1) and, in turn, > substitute these into the first of equations(11.1), ![enter image description here](http://i.stack.imgur.com/fwgvD.png) ![enter image description here](http://i.stack.imgur.com/u3IVZ.png) I want to obtain a fourth-order differential equation that is ![enter image description here](http://i.stack.imgur.com/4rtxy.png) I have read some material in official documentation, but i still don't know how to do this in _Mathematica_. Can somebody help me about this, or just tell me to which book/website I should refer so that I can do the calculation in _Mathematica_.


Interpret TraditionalForm as InputForm

![Every Time](http://i.stack.imgur.com/uj3P3.png) Every time I execute a command in _Mathematica_ , it prompts me whether I would like it to remember my decision to convert TraditionalForm to InputForm. Sadly it doesn't remember my decision ? Any suggestions ?


How can I make my MM code more compact and readable? Can I put functions in different notebooks?

I'm doing some coding in MM9, but my program is getting quite large. It's mostly a bunch of functions defined at the beginning of it, but it's getting to the point where I have to scroll for a few seconds to get to the bottom of the notebook and it's getting annoying to find things without using Ctrl + F. It may seem like nitpicking but it slows down my workflow so I figured I'd ask here. Is there some way to make my code nicer? I once investigated "minimizing" functions but it appears MM doesn't really support that. Could I put some functions and constants in a spare notebook and have my main one read that before executing, like I would in C++? MM is usually so elegant, I imagine there must be a solution for this!


Shift text upwards in graphics so characters with descenders clear horizontal lines

Is there an option to align Text to automatically adjust for font descent? In the attached graphic, strings that contain "g" are visibly shifted upward, even though all strings are uniformly rendered by:               Text[Style[name, FontFamily -> "Helvetica",        FontSize -> 12], {(b + 20), y}, {-1, -0.85}]      ![enter image description here](http://i.stack.imgur.com/Ta0e6.jpg) Is there a way to align strings vertically by the font's baseline? You can also see this issue in a simpler example:                 Graphics[          {Line[{{0, 0}, {1, 0}}],           Text["g", {1/4, 0.01}],           Text["h", {3/4, 0.01}]},          PlotRange -> {All, {-1, 1}}          ]      which somehow doesn't replicate the issue (M9/OSX10.8) ![enter image description here](http://i.stack.imgur.com/2W1n0.jpg)


Exporting a Video of a Simulation of Pendulum Motion

In a series of previous questions, I asked how to solve a series of differential equations describing a series of coupled pendulums, and then how to plot this data by coloring the different pendulums. Using the excellent answers from these two questions, I was able to output a 3-dimensional view of how the pendulums swing. ![Simulation of Pendulums](http://i.stack.imgur.com/TuKVd.png) My system's graphics card is pretty outdated, so using Szabolcs' poor man's antialiasing, I attempted to output a movie of the pendulums' motion. To begin with, my code to generate the individual 3-dimensional views at a given point of time is shown below.               funcposition = Table[{Sin[# + i], 1}, {i, 0, n, 1}] &;          (*the position function of each pendulum, as a function of time. note - this is a dummy variable; you can see the explanation below of why I used a dummy variable. The variable # is the time*)          connectionpoints =        Transpose[{Table[i, {i, 0, n}], Table[0, {i, 0, n}],          Table[0, {i, 0, n}]}];          (*the points where the balls are connected to the supporting stick*)          supportstick = {Black, Thick, Line[{{0, 0, 0}, {n, 0, 0}}]};          (*the thick black supporting stick*)          toPolar = {#2 Cos[# - \[Pi]/2], #2 Sin[# - \[Pi]/2]}\[Transpose] & @@ (#\[Transpose]) &;          (*Mr Wizard's method for coloring the points and producing the output here*)          colors = ColorData["Rainbow"] /@ Rescale@Range@Length@funcposition[0];          (*A three-dimensional plot of the data, including the antialiasing*)          antialiasedthreedpendulumviewer =        ImageResize[         Rasterize[          Graphics3D[{PointSize[Large],              Point[Transpose[               Prepend[Transpose[toPolar@funcposition[#1]],                 Range[n + 1] - 1]], VertexColors -> colors]}~Join~            supportstick~Join~{Black, Thin}~            Join~(Line /@               Partition[               Riffle[Transpose[                 Prepend[Transpose[toPolar@funcposition[#1]],                   Range[n + 1] - 1]], connectionpoints], 2]),            PlotRange -> {{-1, n + 1}, {-1, 1}, {-1, 1}}, Axes -> True,            ViewPoint -> #2, ImageSize -> Large], "Image",           ImageResolution -> 8*72], Scaled[1/4]] &;      To export the images as a video, I then apply the following:               starttime=0;     endtime=0.5;     timestep=0.005     perspective={-0.87, 0.25, 0}          tableofimages =      Table[antialiasedthreedpendulumviewer[tdummy, perspective], {tdummy, starttime, endtime, timestep}];     Export["animation.flv", tableofimages]      However, this process is very slow, and producing even ten frames took me three minutes. My **question** is - how do we improve the performance of the exporting process? As a side question, how would we reduce the file size of the file exported? **Note:** The actual motion of the coupled pendulums is replaced with a toy function in this running example above, as I don't think that the evaluation of the solution is the key rate-determining step for the exporting of the video in the simulation. The actual code that I am running involves solving the ODE first and also replace the `funcposition` with a substitution of the functions' solution.               m = 0.1;     l = 0.2;     b = 1;     mu = 1;     k = 10;     eta = 0.2;     g = 0.2;     a = 1;          g = 9.81;          n = 20;     tmax = 20;          funch = (1 - eta/(2 (1 - Cos[#1 - #2]) + (g/a)^2)^0.5) &;     funcf = # + Abs[#] &;     tau = Sin[#1 - #2]*k*l^2*funcf[funch[#1, #2]] &;          node = b*m*l^2*          D[theta[#][t], {t, 2}] == -g*m*mu*l*           Sin[theta[#][t]] + tau[theta[# - 1][t], theta[#][t]]*           HeavisidePi[(#*(1 + n*$MachineEpsilon) - 1)/n - 0.5] + tau[                theta[# + 1][t], theta[#][t]]*               HeavisidePi[(#*(1 - n*$MachineEpsilon) + 1)/n - 0.5] &;     (*machine epsilon bit is to make side pendula only affected by \     themselves*)          initialposition = theta[#][0] == 0 &;     initialvelocity = theta[#]'[0] == 0 &;          initialconditions = {theta[0][0] == 0, theta[0]'[0] == 50,          theta[1]'[0] == 45, theta[2]'[0] == 40, theta[3]'[0] == 35,          theta[4]'[0] == 30, theta[5]'[0] == 25}~Join~        Table[initialposition[i], {i, 1, n}]~Join~        Table[initialvelocity[i], {i, 6, n}];          (*initial conditions defined as above*)          equations = Table[node[i], {i, 0, n}];     system = equations~Join~initialconditions;     functions = Table[theta[i][t], {i, 0, n}];     solution =  NDSolve[system, functions, {t, 0, tmax}, MaxSteps -> 10000*n*tmax];          funcposition = Table[{(Evaluate[theta[i][t] /.solution] /.t -> #)[[1]], 1}, {i, 0, n, 1}] &;


Latest Mathematica 9.0 can't use Format.m to generate optimized Fortran code

Before updating to _Mathematica_ 9.0, I have successfully generated beautiful Fortran code using Mark Sofroniou's `Format.m` package, which is posted on MathSource. However, after updating to the latest _Mathematica_ , version 9.0, the program can't work; the following error displayed when running the code:               Clear["Global`*"];     << format`Format`     (* -> Get::noopen: Cannot open format`Format`. >> *)      Could anyone tell me how to set up `Format.m` in _Mathematica_ 9.0?


Making a rectangular label for RegionPlot

I have a plot that includes a `Region Plot`. I want to make a rectangle with the same shading as in the region plot to show as a legend. The dumb way I can think off is to make another region plot over a small rectangular space and show that as a legend, but that does not seem like a great idea considering I might want to change the plots. Any better suggestions? For practice, I want to label the following example:               RegionPlot[x^2 + y^3 < 2, {x, -2, 2}, {y, -2, 2},        MeshFunctions -> {(2 #1 - #2) &, (2 #1 - #2) &}, Mesh -> 100]


Can someone explain what the primitives and parameters mean in my Graphics3D code?

Graphics3D[       Table[         GeometricTransformation[           Cuboid[{1, 0, 0}, {.01, .2, .1}],            {RotationMatrix[a, {0, 0, .05}], {.001 Cos[a], .001 Sin[a], a}}],          {a, -Pi, 2 Pi, .2}],        Boxed -> False]      I followed this Documentation Center page about rotating cuboids along a space curve to make the above code (which creates the stairs for spiral staircase). I don't want to just follow it, though, I would like to understand everything I am typing in. After researching the primitives, I know that `Cuboid[{a,b,c},{d,e,f}]` creates a cuboid with corner `{a, b, c}` and opposing corner `{d, e, f}`. But other than that, I'm not all sure what else is going on. I can _guess_ at what is going on, but that does not make me feel confident in my Mathematica usage. Specific questions:   * What does `Table` do? When reading about it, I cannot make sense of why I need it in my code.   * `Graphics3D` creates a 3D image based upon the primitives and directives entered. Is this correct? What else should I know about this?   * To make sure I understand primitives and directives clearly: `Table` is a primitive for `Graphics3D`. `GeometricTransformation` is a primitive for `Table`. `Cuboid` and `RotationMatrix` are primitives for `GeometricTransformation`. `Boxed` is a directive for `Graphics3D`. And things like `{a, b, c}` are parameters for equations or primitives. Is this correct? Sorry, this may read like a riddle.   * Final questions: What exactly does `GeometricTransformation` do? Is it basically saying "I'd like to rotate something (a cuboid) about an axis and in the shape of a helix?" Where are the vectors/matrices coming to play in this? This is where I read about it, but it does not help me much in understanding what I am doing.


How can I improve my code with efficient mathematica built-in functions?

I have written a module for my assignment like below.                V[n + 1] = rk[x[n], y[n] ,z[n], V[n]];      vs = V[n].V[n+1];      V[n + 1] =       I want to modify it with efficient and faster built-in functions like `FoldList`,`FixedPoint`,`ComposeList` etc. I tried `FoldList`, however, I can't get the right syntax for my program. Can I use these functions for this purpose? How would I write them? Or is it better to use program like this? Any help is appreciated.


Is it possible to embed a notebook as a panel in a java GUI?

I'd like to create a GUI that displays a tree, some text boxes, buttons, and then as a panel, a fully-functional notebook. Is that possible?


How can I set ScriptLevel to be 0 for inline math mode?

I hate small integral signs and thus I like ScriptLevel to be 0. I have set ScriptLevel to be 0 for Text cells, DisplayFormula, and InlineFormula. When in a text cell I press ctrl+( to create an inline math mode cell (for lack of better term). When I do this I notice in the option inspector that ScriptLevel is 1 and this causes a small integral sign to be typed. In Mathematica 8 this did not happen. It was ScriptLevel 0. In Mathematica 9 is 1 and I haven't been able to figure how to change it to be 0 by default. I've noticed a number of odd behaviors changed in the new Default.nb and this seems to be one of them. I'm using OS X 10.7.2. When using my notebooks created under Mathematica 8 I get the correct behavior. But not when using new notebooks created in Mathematica 9.


How do I make a frequency heatmap?

I have an array of data that has repeats in it. I want to generate a heatmap depending on how much repetition each point has, as in how many times it is repeated.


Thread over a nested list top to bottom until non-list elements are found

I have a nested list:               list = {1, 2, {3, 4}, f[a], {2, h[b]}}      I would like to apply a function `g` to all elements of the nested list (starting from top to bottom) that are not lists themselves. That is, I would like to obtain:               {g[1], g[2], {g[3], g[4]},  g[f[a]], {g[2], g[h[b]]}}      (Using `Map[g, list, {-1}]` does not work, as it maps `g` inside `f` and `h`) The alternative I have ended up using is the following function:               mapAtLeavesOfList[g_, x_List] := Map[mapAtLeavesOfList[g, #] &, x]     mapAtLeavesOfList[g_, x_] := g[x]          mapAtLeavesOfList[g, list]     => {g[1], g[2], {g[3], g[4]}, g[f[a]], {g[2], g[h[b]]}}      Any better suggestions?


How to draw symmetrical parts of a circle

Let's consider the following simple case:               V = 1/2*(x^2 + y^2) + x^2*y - 1/3*y^3;     h = 0.3;     rad = 6*h;          S1 = ContourPlot[V, {x, -2, 2}, {y, -2, 2}, Contours -> {h},      ContourShading -> False, ContourStyle -> {Darker[Green], Thick},      PlotPoints -> 100, PerformanceGoal :> "Speed", AspectRatio -> 1];     S2 = ContourPlot[x^2 + y^2, {x, -2, 2}, {y, -2, 2}, Contours -> {rad},     ContourShading -> False, ContourStyle -> {Blue, Thick, Dashed},      PlotPoints -> 100, PerformanceGoal :> "Speed", AspectRatio -> 1];     P0 = Show[{S1, S2}, FrameLabel -> {"x", "y"}, RotateLabel -> False,      FrameStyle -> Directive[FontSize -> 20, FontFamily -> "Helvetica"],      PlotRange -> 1.5, ImageSize -> 550]      which gives ![chans](http://i.stack.imgur.com/bqhtu.jpg) We see, that the blue dashed circle intersects the green contour at the three openings (exits). I would like to draw the symmetrical parts of the circle inside these exits. By the term symmetrical, I mean with reverse curvature. I added by hand and with red color in the plot the symmetrical parts. Any ideas how to obtain this? **EDIT** A copy of the above code (in version 9) can be found here:code.


Why is my compiled code slower?

I am trying to make a Mathematica program run faster. Here is part of the original version. It takes as input the integers X (of order 100), J (of order 10000), and n (of order 100), the real number p (of order 1), and the rank 2 list NRR of integers (or order 10000 by 4).                hKer=Table[0,{k,1,X},{j,1,J},{i,1,n}];         For[j=1,j<n+1,j++,         For[i=1,i<n+1,i++,         hKer[[1,j,i]]=KroneckerDelta[j,i]]];         For[k=2,k<X+1,k++,         For[j=1,j<J+1,j++,         For[i=1,i<n+1,i++,         hKer[[k,j,i]]=N[(1-p)hKer[[k-1,j,i]]+(p/Length[NRR[[j]]])Sum[hKer[[k-1,NRR[[j,l]],i]],{l,1,Length[NRR[[j]]]}]]]]];      Searching the internet for advice led me to try compiling this program. Copying an example on stackoverflow, I arrived at the following version.               fhKer=Compile[{{X,_Integer},{J,_Integer},{n,_Integer},{p,_Real},{NRR,_Integer,2}},     Module[{hKer},     hKer=Table[0.,{k,1,X},{j,1,J},{i,1,n}];     Do[hKer[[1,j,i]]=If[j==i,1,0],{j,1,n},{i,1,n}];     Do[hKer[[k,j,i]]=N[(1-p)K[[k-1,j,i]]+(p/Length[NRR[[j]]])Sum[hKer[[k-1,NRR[[j,l]],i]],{l,1,Length[NRR[[j]]]}],{k,2,X},{j,1,J},{i,1,n}];     hKer]]      The compiled program runs more slowly than the original version. I checked that the compiled program does not contain a MainEvaluate, which was put forth as a potential problem on stackexchange. I do not currently have any good ideas either for making the compiled program run more quickly or for modifying the original version to run more quickly. I would greatly appreciate any suggestions.


How to find Matano plane

I have discrete collection of data points (10 to 10^4). I want to describe them by a continuous function and find a `x` value `z`, where areas `S1` and `S2` bounded by `{x, f[x], yBot, yTop}` are equal. Furthermore, I think it is called Matano plane. There is 1 important special case: if function values dips beyond `{yBot, yTop}`, then that area should be added to the other area. Shaded regions on this plot should be equal (S1=blue,S2=yellow): ![enter image description here](http://i.stack.imgur.com/bYFp5.png) Example data for this plot: `n = 3;` and `z` is the divider what I am looking for               rc = RandomChoice[{Sech[2 x - 0.5]/1.5 + 1.5, 2}]     data = Transpose[{        # + RandomReal[] & /@ Range[-10, 30, 2],        Tanh[#] + rc /. x -> # & /@ Range[-4, 4, 0.4]}]     f = GetRLine3[{data}, 3][x];     {xLimits, yLimits} = {       {Min@#1, Max@#1},        {Mean@#2[[1 ;; n]], Mean@#2[[-n ;; -1]]}} & @@ Transpose[data]      Where `GetRLine3` is:               GetRLine3[MMStdata_, IO_: 1][x_: x] :=ListInterpolation[#, InterpolationOrder -> IO,       Method -> "Spline"][x] & /@ (({{#[[1]]}, #[[2]]}) & /@ # & /@ MMStdata);      I can write a adhoc solution that finds `z`, but then it takes about 5.953s to find.               z = step = xLimits[[1]] + (xLimits[[2]] - xLimits[[1]])/2;     While[{part1, part2} = Flatten[{Integrate[f - yLimits[[1]], {x, xLimits[[1]], z}],          -Integrate[(f - yLimits[[2]]), {x, z, xLimits[[2]]}]}] // N; part1 != part2,      If[part1 > part2, step /= 2; z -= step, step /= 2; z += step]]      In this case `z=8.075996010318093`. I can't seem to be able to use solve to find z. I have tried other regression curves   * `Fi`t with `Table[x^k,{k,0,100}]`   * `NonlinearModelFit` with `a/2 Erf[(x-\\[Mu])/(Sqrt[2]\\[Sigma])]+y0` and they are about 10x faster, but they did't work for both small and large sets of data. Finding accurate model or set of functions seems to be beyond me. Is there a better or faster way to solve for z in range `xLimits`.


ListContourPlot-ColorFunction

How can I use ONLY the central 90% of the spectrum, not the whole range? For example, I do not like to see the lowest values in purple, but in deep blue color.               tzvw={{394.5, 0.58, -0.56391}, {394.5, 0.56, -0.580086}, {394.5,      0.54, -0.56415}, {394.5, 0.52, -0.561491}, {394.5,      0.5, -0.572876}, <<3267>>, {90557.4, 0.1, -0.358004}, {90557.4,      0.08, -0.2929}, {90557.4, 0.06, -0.240185}, {90557.4,      0.04, -0.211586}, {90557.4, 0.02, -0.156428}}                ShowLegend[      ListContourPlot[tzvw,       ColorFunction -> ColorData["Rainbow"],        Contours -> Range[-2.25, 2.75, 0.25], ContourLines -> False,       FrameTicks -> {ticklst, Automatic, None, None},       PlotRange -> {Automatic, {0, 0.52}, {-2.25, 2.75}}, FrameStyle -> 20,       AspectRatio -> 0.3, ImageSize -> 700,       "DelaunayDomainScaling" -> True,       RegionFunction -> Function[{x, y, z}, y <= 0.5]]


Why is an integer not considered as a real?

Please consider the following:               zeros={0.,0};        data={1, 0., 0};      DeleteCases[data, #]&/@zeros     Head/@zeros     (*{Real, Integer}*)     (*{{1, 0}, {1, 0.}}*)      For my understanding all integers (e.g. `0`, `2`) are element of the real numbers (e.g. `0.00000`, `2.00000`). So why would Mathematica not delete all zeros form `data`. I know from here that one can solve the `DeleteCases`-problem via `DeleteCases[Rationalize@data,0]` but this is not the point here. **EDIT** The following test may explain my problem slightly better:               sets={Integers,Reals,Complexes};     test=Table[Element[j, i], {i, sets}, {j, zeros}];     (*{{False, True}, {True, True}, {True, True}}*)      `test` returns as expected that `0` is element of `Integers`, `Reals` and `Complexes` for which reason I would expect for `DeleteCases[data, #]&/@zeros` the following result:               {{1}, {1, 0.}}      For the latter `0.` can not be deleted from `data` because I called _delete all 0-Integers_ whereas in the first case all zeros can be deleted as I called _delete all 0-Reals_. **Note:** Instead of `0` and `0.` we could use also `2` and `2.`. The value does not matter.


Is there a way to convert mathematica code to OpenMP or OpenACC?

I see that Mathematica has limited support for things like OpenCL and CUDA, but what about other standards like OpenMP or OpenACC?


Create self-contained plots when Ticks or FrameTicks require external functions

Let's say I define tick marks for a plot in a separate function outside of the plot:               tick[xmin_, xmax_] :=        Map[{#, "", .03} &, FindDivisions[{xmin, xmax}, 4]];     p = Plot[Sin[x], {x, -Pi, Pi}, Frame -> True,         FrameTicks -> {{tick, tick}, {tick, tick}}];     q = Plot[Sin[x], {x, -Pi, Pi}, Axes -> True,         Ticks -> {tick, tick}];      Now these boring plots can be made much more colorful by evaluating this additional command:               Clear[tick]      The result of evaluating `p` (and similarly `q`) is now: ![No ticks](http://i.stack.imgur.com/15wfE.png) I didn't say it's colorful in a good way. This is a problem especially if you have defined your tick function in the initialization of the notebook via `SetOptions[Plot,...]`, and then at a later stage decide to _copy and paste_ the `Graphics` output by one of these plots to another notebook where this initialization is not performed. Assuming that the `Graphics` is a self-contained drawing that can be copied in this way leads to an unpleasant surprise: although you _can_ paste the graphic, you'll get an error when you paste it into a `Show[...]` expression and evaluate it: ![Show pasted](http://i.stack.imgur.com/nXLKI.png) So what to do about this? Of course, I could always embed all the tick functions in the plot itself, as in               q = Plot[Sin[x], {x, -Pi, Pi}, Axes -> True,         Ticks -> ({#, #} &[           Function[{xmin, xmax},             Map[{#, "", .03} &, FindDivisions[{xmin, xmax}, 4]]]])];      But this seems very cumbersome. Alternatively, one could convert to `PDF` and back to `Graphics` using `First@ImportString[ExportString[q,"PDF"],"PDF"]`. But that's a big gun for a very specialized problem. Another possibility is to hit the plot output with `FullGraphics`. However, that's buggy. For example,               FullGraphics[Plot[x^2, {x, -1, 1}, TicksStyle -> RGBColor[1, 0, 0]]]      can't seem to reproduce the red color for the tick marks (confirmed by Wolfram as a bug). So are there any better ways to "burn in" the externally defined tick functions in the above examples so that the plot results can be considered self-contained? I guess I'm thinking of something like `SaveDefinitions->True` for plots. Come to think of it, maybe putting the plot in a `Manipulate` is another option... but ideally, I'd like to have a `Graphics` object. So at the time of generating the plot, one should force Mathematica to store the table of actually generated ticks in the graphic. Actually, something like this already happens in the notebook when I copy and paste a graphic (some data corresponding to the currently displayed graphic are cached). It would be nice if the tick function itself could take care of replacing itself with an explicit tick list. **Edit** The first screenshot is fixed by Rojo's answer, and that part of the question is really not caused by a bug in Mathematica. It's the special status of tick marks that requires the tick function to be available whenever we decide to show the plot output with a different plot range (using `Show`, e.g.). The second screen shot above is caused by a bug (also suggested by Heike's observation), and therefore I can't expect anyone to give a good answer here (except for work-arounds). To show the bug more clearly: I still get an error even with this simple (apparently self-contained) definition:               q1 = Plot[Sin[x], {x, -Pi, Pi}, Axes -> True,        Ticks -> {Function[{xmin, xmax},           Map[{#, "", .03} &, Evaluate@FindDivisions[{xmin, xmax}, 4]]],          Automatic}]      Here is the result of pasting the output from above into a `Show[ ]` statement: ![Still showing error with FindDivisions](http://i.stack.imgur.com/U2atm.png) However, this is "fixed" by changing `FindDivisions[{xmin, xmax}, 4]` to `FindDivisions[{xmin, xmax}, Round[4]]`


How can I speed up the classic GA for graph coloring?

I'm trying to compute the chromatic number of this graph (which is 28):               g = Import@"http://www.info.univ-angers.fr/pub/porumbel/graphs/dsjc250.5.col";      My genetic algorithm is getting stuck at an upper bound of 38 vertex colors:               In[] := Timing @ GAColor[g, 10, 20, 3]     Out[293]= {19.178072, {38, {28, 16, ...., 3, 22}}}      I've written the general GA implementation, but I'm using naive recombination and mutation, and my mathematica code is slow. My question is, how could I improve on this with more clever choices of Combine[] and Mutate[], as well as faster code, in the general? I'm by no means an expert here, so I'm sure there are many possible improvements both theoretically and algorithmically...               GAColor[g_Graph, PopulationSize_Integer:100, NumberOfGenerations_Integer:10, NumberOfMutants_Integer:0, mutationRadius_Integer:Automatic] :=  Module[         {NumberOfVertices = VertexCount @ g, NumberOfBreeders, PermuteColorClasses, MutationRadius, Combine, Mutate, PopulationStep,          InitializePopulation, InitalPopulation, Generations, BestFitness = \[Infinity], BestColoring, GenerationsFitness, Chromatize, Adjacencies, result},              MutationRadius = If[mutationRadius === Automatic, NumberOfVertices, mutationRadius];         Adjacencies = Last /@ Transpose /@ GatherBy[First /@ Most[ArrayRules[AdjacencyMatrix[g]]], First];         NumberOfBreeders = PopulationSize - NumberOfMutants;              PermuteColorClasses[colors_, n_:1] := Module[{p},             p = {#, Flatten @ Position[colors, #]}& /@ Union[colors];             p[[All, 1]] = RandomSample[p[[All,1]]];             ReplacePart[ConstantArray[0, Length[colors]], Flatten[Rule @@@ Thread[Reverse@#]& /@ p]]         ];              Chromatize[colorVector_] := Module[{f, h, min, co = colorVector},             f = Function[{c,v},                 ReplacePart[c, v -> With[{ncols = c[[Adjacencies[[v]]]]},                     For[min = 1, MemberQ[ncols, min], min++]; min]             ]];             h = Function[{c}, Fold[f, c, RandomSample[Range[NumberOfVertices]]]];             FixedPoint[h, co]         ];              Combine[colorVector1_, colorVector2_] := MapThread[RandomChoice[{#1, #2}]&, {colorVector1, colorVector2}];         Mutate[colorVector_, mr_] := Permute[colorVector, RandomPermutation[mr]];              PopulationStep[population_, NumberOfBreeders_] := Module[             {fitness = Max /@ population, breeders, children, mutants},             With[{min = Min[fitness]}, If[min < BestFitness, BestFitness = min]];             breeders = RandomChoice[fitness -> population, NumberOfBreeders];             children = Chromatize /@ Table[Combine @@ RandomChoice[breeders, 2], {NumberOfBreeders}             ];             mutants = Mutate[#, MutationRadius]& /@ RandomChoice[breeders, NumberOfMutants];             Join[children, mutants]         ];              InitalPopulation = With[{color = Chromatize[RandomSample[Range @ NumberOfVertices]]},                 Table[PermuteColorClasses[color], {PopulationSize}]         ];              Generations = NestList[PopulationStep[#, NumberOfBreeders]&, InitalPopulation, NumberOfGenerations];         GenerationsFitness = Map[Max, Generations, {2}];         BestColoring = Extract[Generations, Position[GenerationsFitness, BestFitness, {2}, 1]][[1]];         If[Or @@ (BestColoring[[First[#]]] == BestColoring[[Last[#]]]& /@ First /@ Most[ArrayRules[AdjacencyMatrix[g]]]),             $Failed, {BestFitness, BestColoring}         ]     ]      ## For those with Mathematica 7 or Less Here is code that doesn't use the version 8 Graph object, it's pretty much exactly the same:               GAColor[adjmatrix_, PopulationSize_Integer:100, NumberOfGenerations_Integer:10, NumberOfMutants_Integer:0, mutationRadius_Integer:Automatic] :=  Module[             {NumberOfVertices = Length @ adjmatrix, NumberOfBreeders, PermuteColorClasses, MutationRadius, Combine, Mutate, PopulationStep,              InitializePopulation, InitalPopulation, Generations, BestFitness = \[Infinity], BestColoring, GenerationsFitness, Chromatize, Adjacencies, result},                  MutationRadius = If[mutationRadius === Automatic, NumberOfVertices, mutationRadius];             Adjacencies = Last /@ Transpose /@ GatherBy[First /@ Most[ArrayRules[adjmatrix]], First];             NumberOfBreeders = PopulationSize - NumberOfMutants;                  PermuteColorClasses[colors_, n_:1] := Module[{p},                 p = {#, Flatten @ Position[colors, #]}& /@ Union[colors];                 p[[All, 1]] = RandomSample[p[[All,1]]];                 ReplacePart[ConstantArray[0, Length[colors]], Flatten[Rule @@@ Thread[Reverse@#]& /@ p]]             ];                  Chromatize[colorVector_] := Module[{f, h, min, co = colorVector},                 f = Function[{c,v},                     ReplacePart[c, v -> With[{ncols = c[[Adjacencies[[v]]]]},                         For[min = 1, MemberQ[ncols, min], min++]; min]                 ]];                 h = Function[{c}, Fold[f, c, RandomSample[Range[NumberOfVertices]]]];                 FixedPoint[h, co]             ];                  Combine[colorVector1_, colorVector2_] := MapThread[RandomChoice[{#1, #2}]&, {colorVector1, colorVector2}];             Mutate[colorVector_, mr_] := Permute[colorVector, RandomPermutation[mr]];                  PopulationStep[population_, NumberOfBreeders_] := Module[                 {fitness = Max /@ population, breeders, children, mutants},                 With[{min = Min[fitness]}, If[min < BestFitness, BestFitness = min]];                 breeders = RandomChoice[fitness -> population, NumberOfBreeders];                 children = Chromatize /@ Table[Combine @@ RandomChoice[breeders, 2], {NumberOfBreeders}                 ];                 mutants = Mutate[#, MutationRadius]& /@ RandomChoice[breeders, NumberOfMutants];                 Join[children, mutants]             ];                  InitalPopulation = With[{color = Chromatize[RandomSample[Range @ NumberOfVertices]]},                     Table[PermuteColorClasses[color], {PopulationSize}]             ];                  Generations = NestList[PopulationStep[#, NumberOfBreeders]&, InitalPopulation, NumberOfGenerations];             GenerationsFitness = Map[Max, Generations, {2}];             BestColoring = Extract[Generations, Position[GenerationsFitness, BestFitness, {2}, 1]][[1]];             If[Or @@ (BestColoring[[First[#]]] == BestColoring[[Last[#]]]& /@ First /@ Most[ArrayRules[adjmatrix]]),                 $Failed, {BestFitness, BestColoring}             ]         ]      Here is the sample input graph (as a compressed adjacency matrix) to test it on: http://pastebin.com/t7gnTczD The algorithm should give a chromatic number of 28 in a few seconds. Here are the other benchmarks: http://www.info.univ-angers.fr/pub/porumbel/graphs/ Even in version 8 of Mathematica there still are no tools to compute the chromatic number or index of a graph, let alone a fast upper bound. Here is an illustration of the simulated annealing that's going on inside the algorithm:               g = Uncompress@"1:eJzt...."; (* get this string from pastebin link *)     NumberOfVertices = Length @ g;     color = RandomSample[Range[NumberOfVertices], NumberOfVertices];     n = NumberOfVertices;     A = Last /@ Transpose /@ GatherBy[First /@ Most[ArrayRules[g]], First];          NeighborComplements = Function[c,         Module[{p, n, nc, r},             p = Flatten @ Position[color, c];             n = A[[p]];             nc = Map[color[[#]]&, n, {2}];             Thread @ {p, Complement[Range[c], #, {c}]& /@ nc}         ]     ];          Chromatic[g_, n_, col_:Range[NumberOfVertices]] := Module[{c=col, f, h, slow, fast},         f = Function[{c, v},                 ReplacePart[c,                  v -> Module[{i, com = Complement[Range[n], c[[A[[v]]]]]},                      RandomChoice[Join[com, {c[[v]]}]]                 ]             ]         ];         h = Function[{c}, Fold[f, c, RandomSample[Range[NumberOfVertices], NumberOfVertices]]];         NestWhile[h, c, Max[#]>n&]     ];          AbsoluteTiming[Monitor[color = NestWhile[Chromatic[g, n-=1, #]&, color, (color=#;n>1)&],         ListPlot[Sort @ color, PlotRange -> All, PlotLabel -> Max[color]]]]      This is an optimization problem, and I'm sure some of you know this area intimately. When you run this code you will see a plot of the color classes which decrease slowly to around 30 different colors for the 250 vertices, however this is only a local minimum, the global minimum and chromatic number of the graph is actually 28... so my code is inefficient, if you can design a completely new function, and/or use openCL or JavaLink that is ok too...


Creating word histograms from lists of strings

Consider the following:               StringData1={"Dog","Dog","Dog","Dog","Duck","Duck","Duck","Rabbit","House"};     StringData2={"A dog is in the house.","A dog is outside.",         "Why is everybody talking about a dog?", "Dog", "The duck died in the house.",          "The duck is actually a rabbit.", "Duck", "And the rabbit in fact is a dog",          "I have a dog in my house."};      Using the following function, it is quite easy to plot a histogram for `StringData1`. However the options remain fixed.               StringHistogram[list_] :=      Module[{counter, strings, numbers},       counter = {First@#, Length@#} & /@ (GatherBy@list);       strings = First /@ counter;       numbers = Last /@ counter;            BarChart[numbers, ChartLabels -> strings]       ]      In case of `StringData2` I was wondering whether it would be possible to chop up each sentence into single words (e.g.`{Sentence1,...} -> {{Word1, Word2,...},...}`) and then to run `StringHistogram` on `Flatten@StringData2New`, whereas `StringData2New` is of the form `{{Word1, Word2,...},...}`.


What is the difference between a few simplification techniques?

I am trying to understand the difference between `Refine`, `Simplify` and `FullSimplify`, and when it's more appropriate to use a particular one. The help files on this are not entirely clear. For example, under the help for `Refine` it says > Use `Simplify` for more simplification rules: >   >   >     Refine[Sqrt[x^2 + 2 x y + y^2], x + y >= 0] >     (* Sqrt[x^2 + 2 x y + y^2] *) >   >     Simplify[Sqrt[x^2 + 2 x y + y^2], x + y >= 0] >     (* x + y *) >   From this, I can't imagine why anyone would ever use `Refine`, if `Simplify` will get it simpler. Yet, it keeps turning up in answers on this site (e.g. here, here, or here), where `Simplify` would also work. Then, regarding `Simplify` vs `FullSimplify`, the help file states: > Use `FullSimplify` to simplify expressions involving special functions: Is there a guideline for which sorts of functions are considered "special functions"? I realize that (based on the "More Information" section and personal experience) `FullSimplify` may take longer, but under what circumstances? Is a good general approach to try `Simplify` first, and then only if one is unhappy with the results, then try `FullSimplify`?


Automatically expanding sliders in Manipulate

Is there some way to have all sliders expanded by default in a Manipulator object, i.e. as if I had clicked all "+" signs?


What is the complete list of valid FrontEnd Packet types?

In response to my question How can I get the unchanged Box form of an arbitrary expression? John Fultz answered with a method using the hilariously named `FrontEnd`UndocumentedTestFEParserPacket`. What is the complete list of such Packets?


ImagePadding or other means of getting whitespace when the PlotLabel is a Column or Grid

I have been having problems with exported plots cutting off a pixel or two of the text in the title of my plots. Let's assume we have some data (AR(1) noise with a high autoregressive parameter makes good fake economic data):               testdata =  FoldList[0.99 #1 + #2 &, 1. ,       RandomVariate[NormalDistribution[0, 0.5], {100}] ];      And a title for our graph. We can try:               title =      Column[{Style["This is a test", 24, Bold, FontFamily -> "Arial", Black],          Style["And so is this", 20, FontFamily -> "Arial", Black]},        Center, 0.3, BaselinePosition -> Top]      ![enter image description here](http://i.stack.imgur.com/nbB5t.png) which does give a bit of whitespace at the top. We can also try another setting for `BaselinePosition` as below. As far as I can tell, all the settings other than `Top` look like this.               titleb = Column[{Style["This is a test", 24, Bold,  FontFamily -> "Arial", Black],        Style["And so is this", 20, FontFamily -> "Arial", Black]},        Center, 0.3, BaselinePosition -> Baseline]      ![enter image description here](http://i.stack.imgur.com/jZ13S.png) Now consider what this looks like as a title to a plot:               ListLinePlot[testdata,       BaseStyle -> {FontFamily -> "Arial", FontSize -> 16},       ImageSize -> 400, PlotLabel -> title, Frame -> True,       ImagePadding -> {{Automatic, Automatic}, {Automatic, 1}}]      ![enter image description here](http://i.stack.imgur.com/qntku.png) The linespacing is suddenly a bit wider than required, and there is far too much whitespace above the title. (This would be obvious if the whole plot were `Framed`, but if I do that, the next issue doesn't arise, and I don't want a border around the whole plot anyway.) Now consider the case where the title has `BaselinePosition` other than top. Now the linespacing is still wider than the original column, and there is no whitespace at all above the text. This causes problems when I export the graphic (especially to EMF under Windows for use in PowerPoint or Word) because then the top pixel or so of the text is cut off. (This seems to be related to this issue.)               testplotb =       ListLinePlot[testdata,        BaseStyle -> {FontFamily -> "Arial", FontSize -> 16},        ImageSize -> 400, PlotLabel -> titleb, Frame -> True,        ImagePadding -> {{Automatic, Automatic}, {Automatic, 1}}]      ![enter image description here](http://i.stack.imgur.com/BsXUG.png) If I adjust `ImagePadding`, it increases the space between the plot frame and the title, not above the title. I get the same problem even if I change `Column` to `Grid` or `GridBox` with the relevant options. Adjusting `Spacings` doesn't seem to work for whitespace at the top of the first element, only for the spacing _between_ rows/elements. How can I add just a pixel or two to the whitespace between the top of my custom plotlabel and the edge of an exported graphic? Ideally I'd like to keep the linespacing a little tighter, consistent with how it looks outside the plot, as well.


Store matched variables

**Edit:** I am matching and replacing a particular expression. At the same time... I want to store matched variables for later use. I got it to work with messed up code involving `Block`. Is there a smarter way to do this?               (*Initialize*)     variables = {}; expr = f[x] + g[x] + 3 f[y];          (*now match and replace, and storing the argument into "variables"*)     expr /. f[x_] :> Block[{}, variables = Union[variables, {x}]; fNew[x]]      Now if I type:               variables     (*output is {x,y}*)      I get the desired output. The empty `{}` inside `Block` makes me feel I'm doing this in a kludgy way... (feel free to improve any other parts of the code too!)


Parameters in plot titles

My issue is how to mix strings with variables, specifically in the context of `PlotLabel`: I can put a string as my plot title, and I can also put a variable as a plot title, but I can't put a string _and_ a variable in my plot title. Example:               testplot[a_] := Plot[a x^2, {x, 0, 3}, PlotLabel -> Style[a,20]]     testplot[1]      ![Test plot](http://i.stack.imgur.com/C5GZY.jpg) But what I really want is the plot label to be "a=1". I've tried:               testplot2[a_] := Plot[a x^2, {x, 0, 3}, PlotLabel -> Text["a="a]     testplot2[1]      ![Test plot 2](http://i.stack.imgur.com/duuey.jpg) Which obviously doesn't work as intended. How to do it? Thanks in advance!


Using the Krylov method for Solve: Speeding up a SparseArray calculation

I'm trying to implement this Total Variation Regularized Numerical Differentiation (TVDiff) code in MMA (which I found through this SO answer): essentially I want to differentiate noisy data. The full paper behind the idea is available from LANL. For a related idea, see this Wikipedia article. The **problem I am currently having is the very long time it takes to solve the`Solve` function**. The full TVD function is as follows:               TVD[data_, dx_] :=       Module[{n, ep, c, DD, DDT, A, AT, u0, u, ATb, ofst, kernel, alph, ng,         stopTol, d, iter, xs, i = 0, q, l, g, tol, maxit, p, time, s},       n = Length@data;       ep = 1 10^-6;       c = Table[1/dx, {n + 1}];       DD = SparseArray[{Band[{1, 1}] -> -c, Band[{1, 2}] -> c}, {n,           n + 1}];       DDT = DD\[Transpose];            A[list_] := dx Drop[(Accumulate[list] - 1/2 (list + list[[1]])), 1] ;       AT[list_] :=         dx ( Total[list] Table[1, {n + 1}] -            Join[{Total[list]/2}, (Accumulate[list] - list/2)]);            ofst = data[[1]];       ATb = AT[ofst - data];            kernel[m_] :=         Join[{0}, Table[Exp[-1] BesselI[n, 1], {n, -m, m}], {0}]/         Total[Join[{0}, Table[Exp[-1] BesselI[n, 1], {n, -m, m}], {0}]];            u0 = Join[{0}, Differences[data], {0}];       u = SparseArray[u0];            alph = StandardDeviation@ListConvolve[kernel[2], data]/         StandardDeviation[data];            ng = Infinity;       d = 0;       stopTol = .05;            iter = 100;       xs = Table[Symbol["x" <> ToString@i], {i, n + 1}];       For[i = 0, i < iter, i++,        q = SparseArray[Band[{1, 1}] -> 1/Sqrt[(DD.u)^2 + ep], {n, n}];        l = dx DDT.q.DD;        g = AT[ A[ u ] ] + ATb + alph l.u;             tol = 10^-4;        maxit = 1;        (* preconditioner *)        p = alph SparseArray[Band[{1, 1}] -> Diagonal[l], {n + 1, n + 1}];        time =          AbsoluteTiming[          s = xs /.              First[Solve[Thread[alph l.xs + AT[ A[ xs ] ] == g], xs,                Method -> {"Krylov", Method -> "ConjugateGradient",                  "Preconditioner" -> (p.# &), Tolerance -> tol,                  MaxIterations -> maxit}]];];        u = u - s;        If[Norm[s]/Norm[u] < stopTol, Break[];];        ];       u       ]      Note: lower the `stopTol` value to ensure a better resulting derivative. For comparison, the Matlab code (which I translated to MMA, and is available from the first link) for the "solve" portion is as follows:               s = pcg( @(v) ( alph * L * v + AT( A( v ) ) ), g, tol, maxit, P )      Here, Matlab defines the solver `pcg` as: > pcg(A,b,tol,maxit,M) and pcg(A,b,tol,maxit,M1,M2) use symmetric positive > definite preconditioner M or M = M1*M2 and effectively solve the system > inv(M)*A*x = inv(M)*b for x. If M is [] then pcg applies no preconditioner. > M can be a function handle mfun such that mfun(x) returns M\x. Note also that the `@(v)` is a 'pure function' in Matlab terms, and is allowed as per: > A can be a function handle afun such that afun(x) returns A*x. When I run the two codes, Matlab ends up being ~5-20 times faster than the corresponding MMA code. My MMA implementation of it uses more or less the entire cpu time on the `Solve` function. I tried to find the best corresponding MMA Solver routine that matched the Matlab description via the docs and two different MathGroup archived messages. None of the options (whether given with or without quotes) seem to help at all. For testing purposes, here is some data:               data = {4699.1`, 4728.3`, 4753.3`, 4787.4`, 4794.8`, 4817.5`, 4842.7`,        4877.2`, 4888.2`, 4916.1`, 4933.7`, 4951.5`, 4984.1`, 4984.2`,        5004.`, 5031.`, 5048.1`, 5062.3`, 5083.2`, 5096.`, 5108.5`, 5140.`,        5142.8`, 5142.7`, 5169.1`, 5168.6`, 5165.`, 5191.8`, 5193.7`,        5199.4`, 5189.3`, 5213.6`, 5209.1`, 5208.5`, 5197.`, 5201.2`,        5184.2`, 5191.2`, 5183.7`, 5181.3`, 5183.2`, 5175.6`, 5089.9`,        5068.1`, 5053.9`, 5056.7`, 5063.6`, 5038.2`, 5023.9`, 5027.4`,        4998.8`, 4980.9`, 4961.9`, 4939.3`, 4933.`, 4897.7`, 4879.`, 4874.`,        4857.3`, 4819.2`, 4801.6`, 4775.5`, 4754.9`, 4712.2`, 4708.3`,        4675.8`, 4637.1`, 4634.1`, 4582.6`, 4558.3`, 4531.`, 4507.9`,        4470.4`, 4445.7`, 4435.`, 4404.3`, 4383.5`, 4363.7`}      You can make it bigger (which also coincidentally crashes my MMA if too big...) by:               data = Join[data, Reverse@data, data, Reverse@data, data,         Reverse@data, data];      (rinse & repeat as necessary). The data looks like: ![Mathematica graphics](http://i.stack.imgur.com/cMO3t.png) And the function `TVD[data,1/Length@data]` looks like: ![Mathematica graphics](http://i.stack.imgur.com/RwyEX.png) So, **how can I speed the solver up**? Is Matlab just that much better at 'sparse array' type calculations? Did I not define the right `SparseArrays`? Is there a way to use LinearSolve when the matrix equation is not a simple `A.x` on the left hand side? Any and all speed improvements would be great!


using MathLink for communication with external program from my C program without Mathematica

I have a compiled program with MathLink. I want to use it from other C program, without Mathematica being involved at all. If i create my program with MathLink and connect to this external program, than i get number packets with number of functions: `DefineExternal ["funcname[]" , "{ }" , 89 ]` that registers these functions as external in Mathematica. How could i, from my C programm, call analog of Mathematica `CallPacket[89,{}]` function to call "funcname". Sending directly `MLPutFunction(lp, "funcname")` to this external application does not seems to be working, as, i suppose, it is intended to be used only for communication from external program with Mathematica, or?


Some tutorials on formatting notebook for exporting to pdf

I love the way that Mathematica handles type inn of formulas. It is really easy to type complicated expressions with shortcuts on keyboard. It would be great if I could use Mathematica completely to publish my articles. But why I don't: I cannot find tutorial for styling of notebook for pdf export. How to deal with page numbering, Header, Footer, page breaks, or placing graphs in wanted position, I mean not just to be line by line text. Is this possible? I believe it is, because I'm fascinated with MMA capabilities, but I'm lacking this skills. If someone could write brief tutorials on this, I believe that it would be appreciated by many others. I saw some text where it's emphasized that they are written totally in MMA (and they are really styled well). Thank you for any tips, ways of accomplishing these tasks and for sharing your experience.


Modified ListPlot, how to speed it up

I use Mathematica almost every day for several jobs (computations, graphics, etc.). I admit that this software contains much more options (capabilities) than one user may need. Well, not always since I hit a snag. Let me be more specific: I have a data set which contains hundreds of thousands of sub-lists composing of four items; the first two are the $(x,y)$ coordinates the third is a real number $t$ and the four is always an integer $i$. For the purpose of this question let's generate a random data               n = 50000;     data = Table[{RandomReal[], RandomReal[], RandomReal[{10^-2, 10^4}],      RandomInteger[{0, 2}]}, {i, 1, n}];      OK, now we want to create a two-dimensional plot depicting all the $(x,y)$ points with $i \ne 0$ and assign to each point a color according to the value $log_{10}f$. One may reasonably argue, that for what I describe here I need either `ListDensityPlot` or `ListContourPlot`. Unfortunately, both modules come by default with a nasty drawback which is fatal in my case. The problem is that both modules spread the colors or in other words, they try to join the colors between the points. There should be an option like `Joined -> False` but it isn't. Perhaps this should be forwarded to Wolfram, so as to be considered for the new version of the program. So, for creating my plot I have to push the program to the limits. First, we filter the data, we select only those sub lists with $i ne 0$ and we define a color function (for those which $n = 0$ we assign gray color).               valrange = {-2, 4};     data[[All, 3]] = Rescale[Log10[data[[All, 3]]] // N, valrange];     colfunc[x_, cf_] := If[x[[4]] == 0, Gray, ColorData[cf][1 - x[[3]]]];      Then, more labor work is needed to create the corresponding pallet explaining the colors               Clear[colorbar]     colorbar[{min_, max_}, colorFunction_: Automatic, divs_: 150] :=      DensityPlot[y, {x, 0, 0.1}, {y, min, max}, AspectRatio -> 10,      PlotRangePadding -> 0, PlotPoints -> {2, divs}, MaxRecursion -> 0,      Frame -> True,      FrameLabel -> {{None, Row[{Subscript["log", "10"], "(", Subscript["t", "esc"], ")"}]}, {None, None}},      LabelStyle -> Directive[FontFamily -> "Helvetica", 17],      FrameTicks -> {{None, All}, {None, None}},      FrameTicksStyle -> Directive[FontFamily -> "Helvetica", 15, Plain],      ColorFunction -> colorFunction]      and finally use `ListPlot` to do the job               With[{opts = {ImageSize -> {Automatic, 550}}, cf = "Rainbow"},       Row[{Show[     ListPlot[List /@ data[[All, {1, 2}]],       PlotStyle -> ({PointSize[0.005], colfunc[#, cf]} & /@ 1. data),       AspectRatio -> 1, Frame -> True, RotateLabel -> False,       Axes -> None, FrameTicks -> True, FrameLabel -> {"x", "y"},       LabelStyle -> Directive[FontFamily -> "Helvetica", 20],       ImagePadding -> {{60, 20}, {60, 20}}, opts,       PlotLabel ->        Style["Test 2", FontSize -> 20, Black,         FontFamily -> "Helvetica"]], PlotRange -> 0.9,      PlotRangeClipping -> True],      Show[colorbar[valrange, ColorData[cf][1 - #] &],      ImagePadding -> {{20, 60}, {60, 40}}, opts]}]]      This piece of code works nice when the number of points is relatively small, let's say $n < 10^4$. My real data however, correspond to $n > 5 \times 10^4$. My CPU (Dual Core at 2.2GHz) needs about 15 minutes for this task. On the other hand, when I enter the same amount of data in already built-in modules (i.e use `ListPlot` to plot only the coordinates) the required time does not exceed 60 secs. So, the question: how can I speed up this procedure and lower the CPU time down to let's say no more than 2 minutes? (For testing keep $n = 50000$ which corresponds roughly to a real data set).


Improving NDSolve speed for heavily stiff problems

Having looked around the intergoogles and Mathematica.SE, I thought I'd pose a question with a minimum working example. Here is the situation I am trying to improve:   1. I am solving a 4th order non linear PDE with NDSolve.   2. It is stiff and I use a stiff solver such as BDF or LSODA.   3. On occassion, I have no choice but to increase the `MaxStepFraction` to uncomfortable levels.   4. As a result, the code runs longer than usual (made worse by the fact that it is a stiff equation to begin with) Is there any way I could improve `NDSolve` performance/speed? Here is my minimum example: > >     $HistoryLength = 0; >     Needs["VectorAnalysis`"] >     Needs["DifferentialEquations`InterpolatingFunctionAnatomy`"]; >     Clear[Eq0, EvapThickFilm, h, Bo, \[Epsilon], K1, \[Delta], Bi, m, r] >     Eq0[h_, {Bo_, \[Epsilon]_, K1_, \[Delta]_, Bi_, m_, r_}] := \!\( >     \*SubscriptBox[\(\[PartialD]\), \(t\)]h\) + >         Div[-h^3 Bo Grad[h] + >           h^3 Grad[Laplacian[h]] + (\[Delta] h^3)/(Bi h + K1)^3 Grad[h] + >           m (h/(K1 + Bi h))^2 Grad[h]] + \[Epsilon]/( >         Bi h + K1) + (r) D[D[(h^2/(K1 + Bi h)), x] h^3, x] == 0; >     SetCoordinates[Cartesian[x, y, z]]; >     EvapThickFilm[Bo_, \[Epsilon]_, K1_, \[Delta]_, Bi_, m_, r_] := >       Eq0[h[x, y, t], {Bo, \[Epsilon], K1, \[Delta], Bi, m, r}]; >     TraditionalForm[EvapThickFilm[Bo, \[Epsilon], K1, \[Delta], Bi, m, r]]; >     L = 2*92.389; >   >     TMax = 3100*100; >     Off[NDSolve::mxsst]; >     Clear[Kvar]; >     Kvar[t_] :=  Piecewise[{{1, t <= 1}, {2, t > 1}}] >     (*Ktemp = Array[0.001+0.001#^2&,13]*) >     hSol = h /. NDSolve[{ >           (*Bo,\[Epsilon],K1,\[Delta],Bi,m,r*) >   >           EvapThickFilm[0.003, 0, 1, 0, 1, 0.025, 0], >           h[0, y, t] == h[L, y, t], >           h[x, 0, t] == h[x, L, t], >           (*h[x,y,0] == 1.1+Cos[x] Sin[2y] *) >   >           h[x, y, 0] == >            1 + (-0.25 Cos[2 \[Pi] x/L] - 0.25 Sin[2 \[Pi] x/L]) Cos[ >               2 \[Pi] y/L] >           }, >          h, >          {x, 0, L}, >          {y, 0, L}, >          {t, 0, TMax}, >          Method -> {"BDF", "MaxDifferenceOrder" -> 1}, >          MaxStepFraction -> 1/50 >          ][[1]] // AbsoluteTiming >   A `BDF` limited to Order 1 needs about 41 seconds to solve the equation until *** _failure_ *** while the `LSODA` allowed up to order 12 does a fantastic job of cutting it down to 18 seconds. * * * Now when I increase the `MaxStepFraction`, I obviously increase the grid density. I am currently running a case that has several thousand grid points and has taken **24+** * _HOURS_ *, yes **hours** and hasn't given me a solution yet. This was expected as I have run cases that took about 3-4 hours before with a coarser grid and do hog the ram (they take up about ~3-4GBs mostly because I am exporting data as `.MAT` files) What suggestions could be provided to improve the speed for such a stiff equation? I have also tried stopping tests and it doesn't quite help all the time as I'd rather mathematica quit my program naturally as a result of overbearing stiffness than artificially through a stopping test. (The former has physical significance) Yes, this question bears resemblance to this but I don't think its the same. I have given `Parallelize` a thought but it doesn't work on `NDSolve`. Any options that I have either on the Mathematica front, computing front, or saving the interpolation function data? # Some observation with `LaunchKernel` ## Edit: Using the `LaunchKernel[n]` option just before the `NDSolve` cell didn't do much. My `AbsoluteTiming` barely even changed.               CloseKernels[];     LaunchKernels[3];     L = 2*92.389; TMax = 3100*100;     .........     ......      ## Edit 2: By using `Table` and launching up to 6 kernels, these are the results that I got: > > {{1,{19.454883,InterpolatingFunction[{{0.,184.778},{0.,184.778},{0.,282761.}},<>]}}, > {2,{19.162008,InterpolatingFunction[{{0.,184.778},{0.,184.778},{0.,282761.}},<>]}}, > {3,{18.919101,InterpolatingFunction[{{0.,184.778},{0.,184.778},{0.,282761.}},<>]}}, > {4,{20.166785,InterpolatingFunction[{{0.,184.778},{0.,184.778},{0.,282761.}},<>]}}, > {5,{20.265163,InterpolatingFunction[{{0.,184.778},{0.,184.778},{0.,282761.}},<>]}}, > {6,{20.556365,InterpolatingFunction[{{0.,184.778},{0.,184.778},{0.,282761.}},<>]}}} So with more kernels, the performance actually degraded....? Wha...?


Question about scoping data in a multi-level Manipulate construction

Background: In a module containing an outer / inner manipulate I select the key of data with a dropdownlist in the outer manipulate. Data is read and displayed in the inner manipulate for edit purposes. The outer manipulate contains buttons, one of which is a save button. I want to get the edited data back at that level so that it can be saved. Consider the following _simplified_ example:                 Manipulate[        Column[{j,        Manipulate[k, {k, 1, 5, 1}],         Button["Check", Print[k]]        }],       {j, 1, 10, 1}]      the question then becomes: **"What is the best way to get the variable k scoped to the first / outer manipulate" ?**


How to generate a random tree?

Is it possible to generate a random tree without explicitly constructing a random adjacency matrix that satisfies tree properties? How about a random directed tree? * * * Edit: incredible answer by Vitaliy! What I wanted was somewhat simpler and rm -rf's answer largely pointed me in the right direction. One thing to note is that the `TreeGraph` functions (new in version 8), while easy to use, seem to be lacking some functionality compared to the older `TreePlot` family of functions. In particular, I wanted to make sure that the root of my tree is displayed at the top, and I could not find a way to do it with `TreeGraph` -- please correct me if I missed something! Here is the illustration (notice how `TreeGraph` puts node `1` at the top):               Block[{edges, p1, p2},      edges = Table[DirectedEdge[RandomInteger[{0, i - 1}], i], {i, 1, 8}];      p1 = TreeGraph[edges, GraphStyle -> "DiagramBlack"] ;      p2 = TreePlot[edges /. {DirectedEdge -> Rule}, Top, 0,         DirectedEdges -> True,         VertexRenderingFunction -> ({White, EdgeForm[Black], Disk[#, .1],             Black, Text[#2, #1]} &)];      GraphicsGrid[{{p1, p2}}, ImageSize -> 800]      ]      ![tree visualization](http://i.stack.imgur.com/7Sjij.jpg)


Bug in DateListPlot in Mathematica 10

Mentioned this already in an answer to a related question. DateListPlot in Mathematica 10 has a horrible bug: If two points have the same time coordinate, only one is plotted; the others are ignored. This is different in Mathematica 9, where all points are plotted correctly. Wolfram tells me that they have this bug in their list to be fixed in the next update. For now I made a workaround with a function that makes identical time coordinates differ by a few seconds, so that DateListPlot plots all points. Has anybody another solution?


Giving hints to Integrate

I working with the integral               Integrate[(4*(x^2 + y^2))/(1 + x^2 + y^2)^2 +                 Derivative[0, 1][w][x, y]^2 + Derivative[1, 0][w][x, y]^2 +                  (4*x*Derivative[0, 1][w][x, y] -  4*y*Derivative[1, 0][w][x, y])/(1 + x^2 + y^2),               {x, -Infinity,  Infinity},               {y, -Infinity, Infinity}]      Mathematica is not able to reduce this any further even with `FullSimplify`. I believe this integral diverges to positive infinity, since if we distribute the integrals over the addition, the integral of the first term clearly is positive and diverges and the second term is non-negative. The third term can be negative and arbitrarily large, but it is asymptotically smaller than the second term. If that is correct and provided `w` and its partial partial derivatves are defined throughout the domain, the answer should be `Infinity`, in the same way Mathematica returns `Infinity` for things like `-Log[0]`, despite the usual mathematical issues with this. How can I guide Mathematica to do this? * * * ### Edit The above integral can also be rewritten as               Integrate[((2*x)/(1 + x^2 + y^2) +                    Derivative[0, 1][w][x, y])^2 +               (-((2*y)/(1 + x^2 + y^2)) +                    Derivative[1, 0][w][x, y])^2,         {x, -Infinity, Infinity},         {y, -Infinity, Infinity}]      but Mathematica cannot do anything with that either.


Extract what symbol is set by SetDelayed, Set, TagSet, UpSet, SetAttributes, etc

One of the recent features of the Mathematica Plugin for IntelliJ IDEA (www.mathematicaplugin.halirutan.de) is a _Structure View_ which let's you see information about several definitions that are done in a source file. It currently looks like the left side of the image below: ![enter image description here](http://i.stack.imgur.com/E4iKh.png) To provide such a feature, I need to extract which symbol is set when the user uses things like   * `lhs = rhs` or `lhs := rhs`   * `s /: patt = rhs` or `s /: patt := rhs`   * `lhs ^= rhs` or `lhs ^:= rhs`   * `Options[sym] = rhs`, `Attributes[sym] = rhs`, `SyntaxInformation[sym] = lhs`, `Format[sym] ] = rhs`, `N[sym] = rhs`, `Default[sym] = rhs`   * `sym::tag = rhs` Since in IDEA I cannot evaluate code like one can in _Mathematica_ , I have to extract all those information from inspecting the abstract syntax tree (`TreeForm` in Mathematica). For this, I have a so-called _visitor_ which walks through the tree and collects information. One can easily write such a visitor (or expression parser) in _Mathematica_ itself. I have written a very basic version of such a visitor, which takes a expression like `f[x_]:=x^2` and extracts the symbols which is set and the type of the assignment. Partly, I have simply copied code from Leonids answer here. Before giving the code here are my **Questions:** Can the visitor below be improved? Are there missing cases, things I haven't thought of, things that don't work correctly? Especially `UpSet` is interesting because there, more than one symbol can be set at the same time. * * * Here is a very basic visitor which uses simple pattern matching to check the structure of an expression:               ClearAll[visit];     SetAttributes[visit, {HoldAllComplete}];     visit[s_Symbol] := MakeBoxes[s];     visit[(h : (SetDelayed | Set))[lhs_, _]] := {MakeBoxes[h], visit[lhs]};     visit[(h : (TagSetDelayed | TagSet))[a_, _, _]] := {MakeBoxes[h], visit[a]};     visit[(h : (UpSetDelayed | UpSet))[_[args__], _]] := {MakeBoxes[h], visit[args]};     visit[HoldPattern[Options[sym_] = _]] := {MakeBoxes[Options], visit[sym]};     visit[HoldPattern[Attributes[sym_] = _]] := {MakeBoxes[Attributes], visit[sym]};     visit[HoldPattern[SetAttributes[sym_, _]]] := {MakeBoxes[Attributes], visit[sym]};     visit[HoldPattern[SyntaxInformation[sym_] = _]] := {MakeBoxes[SyntaxInformation], visit[sym]};     visit[HoldPattern[Default[sym_] = _]] := {MakeBoxes[DefaultValues], visit[sym]};     visit[HoldPattern[MessageName[sym_, tag_] = _]] := {MakeBoxes[Messages], visit[sym], MakeBoxes[tag]};     visit[Verbatim[Format][sym_] := _] := {MakeBoxes[FormatValues], visit[sym]};     visit[HoldPattern[(Set | SetDelayed)[N[sym_], _]]] := {MakeBoxes[NValues], visit[sym]};          visit[(Condition | PatternTest | Optional)[arg_, _]] := visit[arg];     visit[(HoldPattern | Optional)[arg_]] := $Failed;     visit[Verbatim[Pattern][sym_, _]] := $Failed     visit[Verbatim[Repeated][p_, ___]] := $Failed;     visit[(Blank | BlankSequence | BlankNullSequence)[___]] := $Failed;     visit[(Longest | Shortest)[arg_, ___]] := $Failed;     visit[Verbatim[PatternSequence][args___]] := $Failed;     visit[a_ /; AtomQ[Unevaluated[a]]] := $Failed;     visit[args___] := List @@ Map[visit, Hold[args]];     visit[f_[args___]] := visit[f];          SetAttributes[StructureView, {HoldAll}];     StructureView[sets_Hold] := Column[List @@ Map[visit, sets]]      And here are some positive test-cases that work               StructureView[Hold[       f[x_] := x^2,       SetAttributes[sym, {HoldAll}],       Options[Plot] = {PlotRange -> Automatic},       square /: area[square] = a^2,       area[rectangle] ^= a*b,       int /: rand[int] = Random[Integer],       h /: f[h[x_]] = x^2,       SyntaxInformation[         f] = {"ArgumentsPattern" -> {_, _, OptionsPattern[]}},       N[f[x_]] := Sum[x^-i/i^2, {i, 20}],       f::usage = "f[x] gives (x - 1)(x + 1)",       area[square1, square2] ^= s^2,       Format[bin[x_, y_]] := MatrixForm[{{x}, {y}}]]]      And here are some test-cases that (correctly) fail because they are semantically not valid               StructureView[Hold[       h_ /: f[h[x_]] = x^2,       f_[x] := x^2,       f_[x_] := x^2,       "f"[x_] := x       ]]      ### Final notes   * I haven't included vector-set like `{a,b}={1,2}` and the special notation `a[[1]]=4` on purpose.   * I someone doesn't want to post a complete answer, but wants to discuss something, then ping me in the plugin chatroom


Background Shading in Histogram3D

I am preparing some data for dissemination. I have a series of plots that look like so, using `ListLinePlot`: ![enter image description here](http://i.stack.imgur.com/qtTlk.png) The background shading is just being added using _Mathematica_ 's drawing tools. However, the following visualization (a 3D Histogram) does not offer similar functionality. Here is the dataset that I am using (I apologize for the length, but hopefully the code box is OK):               dataHistogramSet = {{{1997, 0}, {1997, 0}, {1997, 0}, {1997,           0}, {1997, 0}, {1997, 2}, {1997, 0}, {1997, 0}, {1997, 0}, {1997,           0}, {1997, 0}, {1997, 0}, {1997, 0}, {1997, 0}, {1997,           0}, {1997, 0}, {1997, 0}, {1997, 0}, {1997, 0}, {1997, 0}, {1997,           0}, {1997, 0}, {1997, 0}, {1997, 0}, {1997, 0}, {1997,           0}, {1997, 1}, {1997, 0}, {1997, 0}, {1997, 0}, {1997, 0}, {1997,           0}, {1997, 16}, {1997, 0}, {1997, 1}, {1997, 0}, {1997,           0}, {1997, 0}, {1997, 5}, {1997, 0}, {1997, 5}, {1997, 0}, {1997,           0}, {1997, 5}, {1997, 0}, {1997, 0}, {1997, 0}, {1997,           0}, {1997, 0}, {1997, 0}, {1997, 0}, {1997, 0}, {1997, 0}, {1997,           0}, {1997, 0}, {1997, 0}, {1997, 0}, {1997, 0}, {1997,           0}, {1997, 2}, {1997, 0}, {1997, 0}, {1997, 3}, {1997, 0}, {1997,           0}, {1997, 6}, {1997, 0}, {1997, 1}, {1997, 0}, {1997,           0}, {1997, 4}, {1997, 0}, {1997, 0}, {1997, 0}, {1997,           62}, {1997, 0}, {1997, 0}, {1997, 0}, {1997, 1}, {1997,           0}, {1997, 0}, {1997, 0}, {1997, 0}, {1997, 0}, {1997, 0}, {1997,           0}, {1997, 0}}, {{1998, 0}, {1998, 0}, {1998, 0}, {1998,           0}, {1998, 0}, {1998, 0}, {1998, 1}, {1998, 19}, {1998,           0}, {1998, 0}, {1998, 0}, {1998, 0}, {1998, 0}, {1998, 0}, {1998,           0}, {1998, 0}, {1998, 0}, {1998, 0}, {1998, 0}, {1998,           0}, {1998, 0}, {1998, 1}, {1998, 32}, {1998, 0}, {1998,           0}, {1998, 0}, {1998, 0}, {1998, 6}, {1998, 1}, {1998, 2}, {1998,           0}, {1998, 0}, {1998, 0}, {1998, 0}, {1998, 0}, {1998,           0}, {1998, 0}, {1998, 0}, {1998, 0}, {1998, 3}, {1998, 0}, {1998,           0}, {1998, 1}, {1998, 0}, {1998, 0}, {1998, 0}, {1998,           0}, {1998, 2}, {1998, 0}, {1998, 0}, {1998, 0}, {1998, 0}, {1998,           0}, {1998, 0}, {1998, 2}, {1998, 0}, {1998, 0}, {1998,           0}, {1998, 0}, {1998, 0}, {1998, 0}, {1998, 0}, {1998, 0}, {1998,           0}, {1998, 1}, {1998, 0}, {1998, 3}}, {{1999, 0}, {1999,           0}, {1999, 0}, {1999, 0}, {1999, 0}, {1999, 0}, {1999, 0}, {1999,           0}, {1999, 0}, {1999, 0}, {1999, 3}, {1999, 0}, {1999,           82}, {1999, 0}, {1999, 0}, {1999, 0}, {1999, 7}, {1999,           0}, {1999, 0}, {1999, 25}, {1999, 9}, {1999, 0}, {1999,           0}, {1999, 0}, {1999, 20}, {1999, 0}, {1999, 0}, {1999,           0}, {1999, 0}, {1999, 0}, {1999, 0}, {1999, 0}, {1999, 0}, {1999,           0}, {1999, 1}, {1999, 0}, {1999, 0}, {1999, 0}, {1999,           0}, {1999, 0}, {1999, 0}, {1999, 0}, {1999, 0}, {1999,           33}, {1999, 0}, {1999, 0}, {1999, 23}, {1999, 0}, {1999,           0}, {1999, 0}, {1999, 60}, {1999, 0}, {1999, 11}, {1999,           0}, {1999, 0}, {1999, 0}, {1999, 0}, {1999, 0}, {1999, 0}, {1999,           0}, {1999, 0}, {1999, 0}, {1999, 0}, {1999, 0}, {1999,           0}, {1999, 0}, {1999, 0}, {1999, 3}, {1999, 0}, {1999, 3}, {1999,           0}, {1999, 0}, {1999, 0}, {1999, 0}, {1999, 2}, {1999,           2}, {1999, 0}, {1999, 0}, {1999, 0}, {1999, 0}, {1999, 0}, {1999,           0}, {1999, 0}}, {{2000, 0}, {2000, 0}, {2000, 0}, {2000,           0}, {2000, 0}, {2000, 0}, {2000, 254}, {2000, 4}, {2000,           0}, {2000, 0}, {2000, 0}, {2000, 0}, {2000, 8}, {2000, 0}, {2000,           0}, {2000, 14}, {2000, 0}, {2000, 0}, {2000, 12}, {2000,           72}, {2000, 0}, {2000, 0}, {2000, 0}, {2000, 0}, {2000,           0}, {2000, 0}, {2000, 4}, {2000, 0}, {2000, 0}, {2000, 0}, {2000,           0}, {2000, 0}, {2000, 22}, {2000, 0}, {2000, 0}, {2000,           0}, {2000, 0}, {2000, 0}, {2000, 0}, {2000, 0}, {2000, 0}, {2000,           2}, {2000, 0}, {2000, 0}, {2000, 0}, {2000, 0}, {2000,           0}, {2000, 0}, {2000, 0}, {2000, 0}, {2000, 0}, {2000, 8}, {2000,           0}, {2000, 0}, {2000, 0}, {2000, 0}, {2000, 0}, {2000,           8}, {2000, 0}, {2000, 0}, {2000, 0}, {2000, 0}, {2000, 0}, {2000,           0}, {2000, 0}, {2000, 0}, {2000, 0}, {2000, 0}, {2000,           0}}, {{2001, 0}, {2001, 5}, {2001, 3}, {2001, 0}, {2001,           0}, {2001, 23}, {2001, 0}, {2001, 0}, {2001, 1}, {2001,           0}, {2001, 0}, {2001, 0}, {2001, 0}, {2001, 4}, {2001,           13}, {2001, 0}, {2001, 0}, {2001, 0}, {2001, 0}, {2001,           0}, {2001, 0}, {2001, 0}, {2001, 0}, {2001, 0}, {2001, 0}, {2001,           0}, {2001, 0}, {2001, 16}, {2001, 0}, {2001, 0}, {2001,           0}, {2001, 23}, {2001, 0}, {2001, 4}, {2001, 0}, {2001,           0}, {2001, 0}, {2001, 9}, {2001, 0}, {2001, 0}, {2001, 0}, {2001,           0}, {2001, 1}, {2001, 0}, {2001, 3}, {2001, 5}, {2001,           0}, {2001, 28}, {2001, 0}, {2001, 0}, {2001, 0}, {2001,           0}, {2001, 10}, {2001, 0}, {2001, 0}, {2001, 0}, {2001,           71}, {2001, 0}, {2001, 0}, {2001, 51}, {2001, 2}, {2001,           0}, {2001, 0}, {2001, 0}, {2001, 0}, {2001, 0}, {2001, 0}, {2001,           0}, {2001, 0}, {2001, 0}, {2001, 0}, {2001, 0}, {2001,           0}}, {{2002, 0}, {2002, 0}, {2002, 0}, {2002, 0}, {2002,           0}, {2002, 0}, {2002, 0}, {2002, 0}, {2002, 6}, {2002, 0}, {2002,           0}, {2002, 0}, {2002, 0}, {2002, 0}, {2002, 0}, {2002,           26}, {2002, 0}, {2002, 0}, {2002, 0}, {2002, 0}, {2002,           0}, {2002, 0}, {2002, 0}, {2002, 0}, {2002, 0}, {2002, 0}, {2002,           0}, {2002, 2}, {2002, 0}, {2002, 0}, {2002, 0}, {2002,           0}, {2002, 21}, {2002, 0}, {2002, 15}, {2002, 0}, {2002,           0}, {2002, 0}, {2002, 0}, {2002, 0}, {2002, 0}, {2002, 0}, {2002,           5}, {2002, 1}, {2002, 0}, {2002, 0}, {2002, 0}, {2002,           0}, {2002, 0}, {2002, 0}, {2002, 0}, {2002, 0}, {2002, 0}, {2002,           0}, {2002, 3}, {2002, 0}, {2002, 0}, {2002, 0}, {2002,           0}, {2002, 0}, {2002, 0}, {2002, 0}, {2002, 0}, {2002, 0}, {2002,           0}, {2002, 5}, {2002, 0}, {2002, 2}, {2002, 1}, {2002,           1}, {2002, 0}, {2002, 0}, {2002, 0}, {2002, 0}, {2002, 0}, {2002,           0}, {2002, 0}, {2002, 2}}, {{2003, 0}, {2003, 1}, {2003,           0}, {2003, 0}, {2003, 15}, {2003, 0}, {2003, 0}, {2003,           0}, {2003, 18}, {2003, 0}, {2003, 0}, {2003, 2}, {2003,           0}, {2003, 0}, {2003, 6}, {2003, 0}, {2003, 0}, {2003, 0}, {2003,           0}, {2003, 6}, {2003, 0}, {2003, 0}, {2003, 0}, {2003,           98}, {2003, 0}, {2003, 11}, {2003, 0}, {2003, 0}, {2003,           0}, {2003, 2}, {2003, 4}, {2003, 0}, {2003, 0}, {2003, 3}, {2003,           1}, {2003, 15}, {2003, 3}, {2003, 0}, {2003, 0}, {2003,           0}, {2003, 5}, {2003, 0}, {2003, 0}, {2003, 0}, {2003, 0}, {2003,           26}, {2003, 0}, {2003, 0}, {2003, 0}, {2003, 0}, {2003,           0}, {2003, 1}, {2003, 0}, {2003, 0}, {2003, 4}, {2003, 0}, {2003,           0}, {2003, 0}, {2003, 19}, {2003, 1}, {2003, 0}, {2003,           0}, {2003, 0}, {2003, 6}, {2003, 0}, {2003, 0}, {2003, 0}, {2003,           0}, {2003, 0}, {2003, 0}, {2003, 0}, {2003, 0}, {2003,           0}, {2003, 4}, {2003, 0}, {2003, 0}, {2003, 0}, {2003, 0}, {2003,           0}, {2003, 0}, {2003, 0}, {2003, 0}, {2003, 0}, {2003,           0}, {2003, 0}, {2003, 0}, {2003, 0}, {2003, 0}, {2003,           7}}, {{2004, 0}, {2004, 0}, {2004, 0}, {2004, 0}, {2004,           0}, {2004, 0}, {2004, 0}, {2004, 0}, {2004, 0}, {2004,           30}, {2004, 0}, {2004, 0}, {2004, 0}, {2004, 0}, {2004,           0}, {2004, 0}, {2004, 0}, {2004, 0}, {2004, 6}, {2004,           20}, {2004, 0}, {2004, 0}, {2004, 0}, {2004, 0}, {2004,           0}, {2004, 0}, {2004, 4}, {2004, 0}, {2004, 0}, {2004, 0}, {2004,           2}, {2004, 0}, {2004, 0}, {2004, 1}, {2004, 0}, {2004,           2}, {2004, 0}, {2004, 0}, {2004, 2}, {2004, 0}, {2004,           46}, {2004, 6}, {2004, 0}, {2004, 0}, {2004, 0}, {2004,           107}, {2004, 0}, {2004, 1}, {2004, 0}, {2004, 0}, {2004,           0}, {2004, 1}, {2004, 5}, {2004, 0}, {2004, 0}, {2004, 0}, {2004,           0}, {2004, 5}, {2004, 0}, {2004, 0}, {2004, 0}, {2004,           0}, {2004, 0}, {2004, 8}, {2004, 0}}, {{2005, 0}, {2005,           0}, {2005, 0}, {2005, 6}, {2005, 0}, {2005, 0}, {2005, 0}, {2005,           4}, {2005, 0}, {2005, 0}, {2005, 0}, {2005, 23}, {2005,           140}, {2005, 0}, {2005, 1}, {2005, 1}, {2005, 0}, {2005,           0}, {2005, 0}, {2005, 0}, {2005, 0}, {2005, 0}, {2005, 2}, {2005,           0}, {2005, 0}, {2005, 0}, {2005, 0}, {2005, 0}, {2005,           0}, {2005, 13}, {2005, 0}, {2005, 2}, {2005, 0}, {2005,           9}, {2005, 0}, {2005, 0}, {2005, 0}, {2005, 0}, {2005, 0}, {2005,           2}, {2005, 5}, {2005, 0}, {2005, 9}, {2005, 2}, {2005,           2}, {2005, 0}, {2005, 4}, {2005, 0}, {2005, 16}, {2005,           0}, {2005, 7}, {2005, 0}, {2005, 0}, {2005, 3}, {2005, 0}, {2005,           0}, {2005, 0}, {2005, 1}, {2005, 0}, {2005, 0}, {2005,           3}, {2005, 0}, {2005, 0}, {2005, 0}, {2005, 3}, {2005,           71}, {2005, 0}, {2005, 0}, {2005, 0}, {2005, 0}, {2005,           0}}, {{2006, 0}, {2006, 0}, {2006, 0}, {2006, 0}, {2006,           0}, {2006, 4}, {2006, 15}, {2006, 7}, {2006, 2}, {2006,           1}, {2006, 0}, {2006, 0}, {2006, 3}, {2006, 0}, {2006, 0}, {2006,           0}, {2006, 0}, {2006, 0}, {2006, 0}, {2006, 2}, {2006,           9}, {2006, 0}, {2006, 0}, {2006, 0}, {2006, 0}, {2006,           97}, {2006, 0}, {2006, 4}, {2006, 0}, {2006, 0}, {2006,           0}, {2006, 0}, {2006, 0}, {2006, 0}, {2006, 0}, {2006, 0}, {2006,           1}, {2006, 0}, {2006, 0}, {2006, 0}, {2006, 1}, {2006,           0}, {2006, 0}, {2006, 0}, {2006, 1}, {2006, 1}, {2006, 0}, {2006,           0}, {2006, 6}, {2006, 0}, {2006, 1}, {2006, 1}, {2006,           8}, {2006, 0}, {2006, 0}, {2006, 0}, {2006, 0}, {2006, 2}, {2006,           0}, {2006, 0}, {2006, 0}, {2006, 0}, {2006, 0}, {2006,           0}, {2006, 5}, {2006, 0}, {2006, 3}, {2006, 0}, {2006,           25}}, {{2007, 0}, {2007, 0}, {2007, 0}, {2007, 0}, {2007,           6}, {2007, 0}, {2007, 0}, {2007, 0}, {2007, 2}, {2007, 0}, {2007,           0}, {2007, 254}, {2007, 0}, {2007, 81}, {2007, 0}, {2007,           0}, {2007, 0}, {2007, 2}, {2007, 6}, {2007, 18}, {2007,           0}, {2007, 0}, {2007, 21}, {2007, 20}, {2007, 0}, {2007,           0}, {2007, 7}, {2007, 0}, {2007, 0}, {2007, 0}, {2007, 6}, {2007,           5}, {2007, 0}, {2007, 0}, {2007, 0}, {2007, 1}, {2007,           2}, {2007, 0}, {2007, 0}, {2007, 11}, {2007, 0}, {2007,           0}, {2007, 0}, {2007, 2}, {2007, 7}, {2007, 0}, {2007, 0}, {2007,           5}, {2007, 3}, {2007, 0}, {2007, 0}, {2007, 0}, {2007,           0}, {2007, 0}, {2007, 0}, {2007, 0}, {2007, 0}, {2007, 0}, {2007,           0}, {2007, 0}, {2007, 0}, {2007, 3}, {2007, 0}}, {{2008,           0}, {2008, 0}, {2008, 166}, {2008, 10}, {2008, 0}, {2008,           0}, {2008, 0}, {2008, 0}, {2008, 12}, {2008, 0}, {2008,           0}, {2008, 0}, {2008, 30}, {2008, 0}, {2008, 0}, {2008,           14}, {2008, 0}, {2008, 0}, {2008, 0}, {2008, 0}, {2008,           0}, {2008, 0}, {2008, 0}, {2008, 2}, {2008, 0}, {2008, 0}, {2008,           0}, {2008, 4}, {2008, 0}, {2008, 0}, {2008, 0}, {2008,           0}, {2008, 0}, {2008, 0}, {2008, 48}, {2008, 0}, {2008,           0}, {2008, 6}, {2008, 0}, {2008, 0}, {2008, 0}, {2008, 0}, {2008,           0}, {2008, 0}, {2008, 2}, {2008, 4}, {2008, 0}, {2008,           0}, {2008, 0}, {2008, 0}, {2008, 0}, {2008, 194}, {2008,           0}, {2008, 10}, {2008, 218}, {2008, 0}, {2008, 20}, {2008,           0}, {2008, 8}, {2008, 2}, {2008, 0}, {2008, 24}, {2008,           34}, {2008, 0}, {2008, 0}, {2008, 22}, {2008, 4}, {2008,           0}}, {{2009, 1}, {2009, 0}, {2009, 0}, {2009, 0}, {2009,           2}, {2009, 0}, {2009, 2}, {2009, 1}, {2009, 2}, {2009, 0}, {2009,           13}, {2009, 0}, {2009, 0}, {2009, 0}, {2009, 95}, {2009,           12}, {2009, 1}, {2009, 0}, {2009, 1}, {2009, 0}, {2009,           0}, {2009, 0}, {2009, 13}, {2009, 0}, {2009, 3}, {2009,           0}, {2009, 0}, {2009, 0}, {2009, 0}, {2009, 0}, {2009, 0}, {2009,           0}, {2009, 0}, {2009, 0}, {2009, 0}, {2009, 0}, {2009,           6}, {2009, 2}, {2009, 2}, {2009, 19}, {2009, 0}, {2009,           0}, {2009, 0}, {2009, 1}, {2009, 6}, {2009, 0}, {2009, 0}, {2009,           48}, {2009, 4}, {2009, 81}, {2009, 26}, {2009, 0}, {2009,           0}, {2009, 0}, {2009, 34}, {2009, 133}, {2009, 0}, {2009,           0}, {2009, 0}, {2009, 11}, {2009, 0}, {2009, 1}, {2009,           0}, {2009, 0}, {2009, 0}, {2009, 6}, {2009, 19}, {2009,           0}, {2009, 0}, {2009, 0}}, {{2010, 0}, {2010, 17}, {2010,           0}, {2010, 0}, {2010, 12}, {2010, 0}, {2010, 0}, {2010,           32}, {2010, 0}, {2010, 2}, {2010, 1}, {2010, 0}, {2010,           47}, {2010, 0}, {2010, 0}, {2010, 0}, {2010, 14}, {2010,           0}, {2010, 0}, {2010, 3}, {2010, 0}, {2010, 3}, {2010,           185}, {2010, 0}, {2010, 225}, {2010, 0}, {2010, 0}, {2010,           0}, {2010, 7}, {2010, 0}, {2010, 0}, {2010, 0}, {2010, 9}, {2010,           0}, {2010, 0}, {2010, 0}, {2010, 0}, {2010, 2}, {2010,           9}, {2010, 15}, {2010, 119}, {2010, 0}, {2010, 0}, {2010,           0}, {2010, 5}, {2010, 0}, {2010, 0}, {2010, 0}, {2010, 0}, {2010,           0}, {2010, 35}, {2010, 0}, {2010, 1}, {2010, 0}, {2010,           0}, {2010, 0}, {2010, 0}, {2010, 0}, {2010, 5}, {2010, 0}, {2010,           1}, {2010, 4}, {2010, 0}, {2010, 0}, {2010, 0}, {2010,           0}, {2010, 0}, {2010, 0}, {2010, 0}}};      and the command:               Histogram3D[dataHistogramSet, FaceGrids -> {Bottom, Front, Left},      ChartStyle -> "GrayTones", ViewPoint -> {2.78, 1.3, 1.43},      PlotLabel -> "Histogram of Dataset 1"]      ![enter image description here](http://i.stack.imgur.com/tzcKt.png) I would like to reproduce the shading (as per the years) in this histogram: i.e. between 1997 and 2002, no background shading; between 2002 and 2005, very light shading; between 20005 and 2010, darker shading. I have searched the documentation for `Histogram3D` and elsewhere to no avail. Can something like this be achieved in _Mathematica_ or do I need to do post-processing elsewhere?


How to make a case insensitive sorted list and rename the file names of a given folder?

Suppose I had about 500 `.JPG` and `.jpg` files in my folder `"c:\images\"`. How to ask Mathematica to load all the `.jpg` and `.JPG` file names then make a case insensitive sorted list out of them, say `{"butterfly.jpg", "Fish.jpg", "marilyn.jpg", "Rabbit.JPG"... }`, and finally rename the files in the folder as: ![enter image description here](http://i.stack.imgur.com/uZXw8.gif)               fnameLst = FileNameTake/@       FileNames[{"*.jpg", "*.JPG", "*.jpeg", "*.JPEG"}, "c:\\images", Infinity]


Elegant way to transform formula with sum into code

I have this formula, and many other which contains sum, I am perfectly able to do the computation over a list, however to do this I need to do it in several _manual_ steps. Therefore, I wonder if there would be any elegant way of adding sequence to it or hold the expression or something similar making it run without needing to do step wise computation _manually_. $$\frac{(x-\bar{x})}{\sum (x-\bar{x})^2}$$ Please note by manually I mean example calculating the mean first and then subtract it from the list and then sum it and so on.


Where did I go wrong with my implementation of the trapezoidal rule?

One method for doing quadrature, called the trapezoidal rule, improves accuracy by connecting the points on the curve corresponding to the points of subdivision with line segments, forming trapezoidal approximations of the area in place of rectangular approximations. ![enter image description here](http://i.stack.imgur.com/fKYwE.png) I tried to use this method to caculate the integral of $x \ln(x)$ over $[1,2]$. Here is what I have:               area[a0_, b0_, n_, function0_] :=        Module[{a = a0, b = b0, Δx, xStart, function = function0, result},         Δx = (b - a)/n;         xStart[i_] := a + i Δx;         result =            N[(Sum[2 function[xStart[i]], {i, 1, n - 1}] + function @ a + function @ b) Δx/2]]          area[1, 2, 100, x Log @ x]      Unfortunately, it doesn't give the result that I want. Where have I gone wrong?


How to get shadows in Graphics3D?

It was a shock to me when I found that in `Graphics3D` a surface is always transparent to the light sources:               lightSources = {{"Directional", Red, Scaled[{1/2, 1, 1}]},                      {"Directional", Green, Scaled[{1, 1/2, 1}]},                      {"Directional", Blue, Scaled[{0, 0, 0}]}};     Show[Plot3D[Sin[x y], {x, 0, Pi}, {y, 0, Pi},        Lighting -> lightSources],       Graphics3D[{PointSize[Large],         Point[lightSources[[All, 3]],          VertexColors -> lightSources[[All, 2]]]}]]      ![plot](http://i.stack.imgur.com/8W8Sa.png) One can see the surface on the right is blue-illumunated although this surface is completely shaded from the blue light source located at the point `{0,0,-1}`. I feel such rendering is unacceptable. Is it possible to produce shadows in _Mathematica_? ## UPDATE To clear up: by "shadows" I mean that the surfaces on the scene must not be transparent to the light sources (or, better, their transparency could be defined by a user). I need not drop shadows shown in the linked threads: (1), (2).


Applying rules to rewrite expressions that contain patterns

I'm trying to write a rule that can rewrite a pattern that exists in another expression. For some reason, this is proving to be more challenging than I expected ... most likely because I'm not totally understanding how Mathematica implements its pattern matching mechanism. Here's my simple test case:               foo = Foo[a: {A,B,C}, b: {a,b,c}]    (* FullForm yields: Foo[Pattern[a,A],Pattern[b,B]] *)      I want to rewrite the portion `b : {a,b,c}` with some other expression, like `Reverse[<b>]` which should yield: `b : {c,b,a}`. Here's what I've tried to far (none of which works):               foo /. (b:X_) -> Reverse[X]                 (* #1 produces Foo[b: {a,b,c}, a: {A,B,C}] *)          foo /. Hold[(b : B_)] -> Reverse[B]         (* #2 no effect *)          foo /. HoldForm[(b : B_)] -> Reverse[B]     (* #3 no effect *)          foo /. HoldPattern[(b : B_)] -> Reverse[B]  (* #4 same as case #1 *)          foo /. (b : B_List) -> Reverse[B]           (* #5 reverses both a:{} and b:{} *)


Erfc Not Returning Results Specified in Documentation

In the documentation for Erfc (under "Possible Issues"), the following command returns a number that is extremely close to 2: ![enter image description here](http://i.stack.imgur.com/x3wFb.png) However, when I run this same command in a fresh kernel, I get: ![enter image description here](http://i.stack.imgur.com/FfKRy.png) What's going on here? Wrapping the command in N[#, 1000] doesn't seem to help. I'm using Mathematica 8.0.1 on OS X.


How can I keep a plot's filled area from obstructing other lines when exported as EPS?

I am plotting several functions, some of which have fillings. After I combine all the functions together on a plot and export the plot to an EPS file, the fillings obstruct other lines. Exported PDF files are fine. Minimal Working Example:               Show[       Plot[.5, {x, -1, 2}, PlotStyle -> {Thick, Dashed}],       Plot[Sinh[x], {x, -1, 2}, Filling -> Axis]]      (I know I can write the two functions into a single `Plot` command, but I have to use `Show` to combine several separate plots in the real problem.) Link to the exported EPS file I can avoid the obstruction by saving the graphic as a bitmap, but the overall quality seems to be degraded.


Changing bounds of summation after differentiating symbolic sums

Suppose, I have a function written as Taylor-Maclaurin series               f = Sum[c[n]*x^n, {n, 0, Infinity}]      Now, I wish to differentiate this expression with respect to `x` symbolically               D[f, x]     (* --->     Sum[n*x^(-1 + n)*c[n], {n, 0, Infinity}] *)      Resulting expression is correct except from the fact that expansion starts from `n=1` now, because `n=0` term vanishes after differentiation (if done explicitly). In this case it isn't a problem because `n=0` term vanishes anyway, but for more complicated computations it may be the reason for breaking further simplifications. So, my question is: How can I teach Mathematica to correctly change bounds of summation?


Keeping Nonlinear Model Fit Real

So I am using the `NonlinearModelFit` (NLM) command with a fairly simple function. There are 4 unknowns and the `(x, y)` points that I am fitting the function to. I am getting my approximations from a `Manipulate` so I can just tweak the values till it's close enough. But once I get the values into the NLM, I get this error about the function value not being a real number at these values (not the same values that I put into the NLM). I have tried several different sets of values and every time I get the same error. I do have two constraints that keep two of my values positive.               R = 0.42; Sigma = 73.06967052; Theta=1.32757;          nData={{0.989939, 4.62}, {0.989939, 4.64}, {0.989939, 4.66},            {0.989939, 4.68}, {0.989939, 4.7}, {0.989939, 4.72},            {0.989939, 4.74}, {0.989939, 4.76}, {0.989939, 4.78},            {0.989939, 4.8}, {0.99398, 4.82}, {0.99398, 4.84},            {0.99398, 4.86}, {0.99398, 4.88}, {0.99398, 4.9},            {0.99398, 4.92}, {0.99398, 4.94}, {0.99398, 4.96},            {0.99398, 4.98}, {0.99398, 5}, {0.99398, 5.02},            {0.99398, 5.04}, {0.99398, 5.06}, {0.99398, 5.08},            {0.99398, 5.1}};          nlm = NonlinearModelFit[         nData,          {((3 + s)/(1 + s) 1/R (h + dh)^(1 + s))* ((p/(Sigma*Cos[Theta]))^s)*             Hypergeometric2F1[1 + s, s, 2 + s, (h + dh)/h0], s > 0, p > 0},          {{p, 0.207}, {s, 1}, {h0, 2.04}, {dh, 0.9}}, h      ]


A fast, robust DropWhile

For reasons that have never been entirely clear to me, _Mathematica_ has had a built-in `TakeWhile` function since version 6.0, but has no equivalent `DropWhile` function. This means that I find myself periodically writing my own. Since this is a function that I use fairly frequently, I'd like to have a version that is both fast and robust. It's also the kind of function that you can write in a bunch of ways; I've tested variants that depend on `While` loops, on using `Scan` and `Throw`, and on using `Position`. Of these, a version using `Position` is the fastest I've found:               DropWhile[list_, test_] :=       With[{pos =         Position[list, elt_ /; ! TrueQ@test[elt], {1}, 1, Heads -> False]},       pos /. {         {} -> {},         {{fail_}} :> Drop[list, fail - 1]        }];      The `TrueQ` slows things down a bit, but is there to match the observed behavior of `TakeWhile`, which takes elements only as long as the test function returns `True`. Are there good ways to make this function work faster?


Error message from evaluating NonlinearModelFit

I am trying to fit data to a Morse potential using `NonlinearModelFit` as follows:               morse[r_] := d (1 - Exp[a (re - r)])^2;     nlm1 = NonlinearModelFit[data1,        d (1 - Exp[a (re - r)])^2, {d, {a, 1.5}, {re, 1.5}}, r]      However upon doing so I get the following error: > `NonlinearModelFit::cvmit:` Failed to converge to the requested accuracy or > precision within 100 iterations. I have tried using different values for my constant and it's puzzling that the data does not fit. Here is the data I am using currently:               {"Internuclear Separation ()", "Potential Energy (eV)"}, {2.2678,        1.44954}, {2.274, 1.41403}, {2.2801, 1.3726}, {2.2864,        1.32543}, {2.2929, 1.27275}, {2.3, 1.2149}, {2.3077,        1.15223}, {2.3163, 1.08509}, {2.3258, 1.01378}, {2.3364,        0.938569}, {2.3482, 0.859714}, {2.3614, 0.777423}, {2.376,        0.691882}, {2.3924, 0.603253}, {2.411, 0.511677}, {2.4324,        0.417273}, {2.4577, 0.320146}, {2.4891, 0.220385}, {2.5321,        0.118071}, {2.6176, 0.0132722}, {2.7173, 0.0132722}, {2.834,        0.118071}, {2.9083, 0.220385}, {2.9715, 0.320146}, {3.0294,        0.417273}, {3.0844, 0.511677}, {3.1379, 0.603253}, {3.1909,        0.691882}, {3.2443, 0.777423}, {3.2987, 0.859714}, {3.3549,        0.938569}, {3.4136, 1.01378}, {3.4758, 1.08509}, {3.5424,        1.15223}, {3.6149, 1.2149}, {3.6949, 1.27275}, {3.7846,        1.32543}, {3.8867, 1.3726}, {4.0049, 1.41403}, {4.144, 1.44954}}      Any ideas?


Use TextRecognize to grab timestamps from a video frame

I have microscope videos that have a timestamp overlay to them, and it would be great if I could extract this for each frame to add to my metadata. `TextRecognize` fails to accurately grab the numbers from the image that looks this (scaled by 4): ![enter image description here](http://i.stack.imgur.com/YCYUO.png) I have tried cropping in different ways, scaling, and several image processing methods (binarize, morphological operations, etc). I also tried prepending text to avoid the issue where `TextRecognize` does not detect the initial digits. I believe this to be a image quality problem. I was wondering if anyone has a recommendation on how to clean this up so `TextRecognize` can detect at least the time in images like this.


Piecewise linear Interpolation between data points

Is there some sort of functionality built into _Mathematica_ that will let me linearly interpolate between (x, y) pairs of data in an array? Example: I have the two points (1, 10) and (2, 20), how can I find out what the interpolant at 1.5 would be?