Generating Linear Extensions of a Partial Order

Given a set $S$ and a partial order $\prec$ over $S$, I'm looking for a way to "efficiently" generate a list of linear extensions of $\prec$. Suppose the partial order is given by a `List` of pairs $\\{x,y\\}$ such that $x,y\in S$. For example, if $S = \\{a,b,c\\}$, then $\\{\\{a,c\\},\\{b,c\\}\\}$ defines a partial order where $a \prec c$ and $b \prec c$. Essentially, given a list $S$ and a list of pairs $P$, I want to generate a list of permutations which respect the orders of the pairs in $P$.               linearExtensions[{a, b, c, d, e}, {{a, b}, {c, b}, {c, d}, {e, d}}]     (* {{a, c, b, e, d}, {a, c, e, b, d}, {a, c, e, d, b}, {a, e, c, b, d},         {a, e, c, d, b}, {c, a, b, e, d}, {c, a, e, b, d}, {c, a, e, d, b},         {c, e, a, b, d}, {c, e, a, d, b}, {c, e, d, a, b}, {e, a, c, b, d},         {e, a, c, d, b}, {e, c, a, b, d}, {e, c, a, d, b}, {e, c, d, a, b}} *)      Since $\\{a,b\\}$ is in $P$, the permutation $\\{b, c, a, d, e\\}$ is not a linear extension because $b$ comes before $a$. I've written two different functions which do the job, both using pattern matching, but I've been using Mathematica for less than a week and am still getting into the functional mindset. I'm interested to see how seasoned Mathematica users would tackle this problem. My first approach was to use `NestWhile` (edit: this is ugly! I did not know about the `Fold[]` function when I wrote this):               linearExtensions[set_, po_] :=          Module[{patterns},             patterns = {___, #[[1]], ___, #[[2]], ___}& /@ po;             First@NestWhile[{Cases[#[[1]], First[#[[2]]]], Rest[#[[2]]]}&,                 {Permutations[set], patterns}, Length[#[[2]]] > 0&]         ]      My second approach, which turned out to be significantly slower, was to expand a set of rules from the partial order and use `Select` on the list of permutations.               linearExtensions[set_, po_] :=         Module[{poQ},             poQ[rule_] := And @@ (MatchQ[rule, {___, #[[1]], ___, #[[2]], ___}]& /@ po);             Select[Permutations[set], poQ[#]&]         ]      Note that on a list of length $n$ there can be $\Omega(n!)$ linear extensions, so by "efficient," I don't mean polynomial-time.


Bad numerical approximations

I'm trying to do some calculations here, but for some reason Mathematica starts using numerical approximations that are no good for my work. Specifically:               T[t_] := {(-Sin[t])/(Sqrt[1 + Cos[t/2]^2]),      (Cos[t])/(Sqrt[1 + Cos[t/2]^2]), (Cos[t/2])/(Sqrt[1 + Cos[t/2]^2])}          B[t_] := {(-0.5 Cos[t] Sin[t/2] + Cos[t/2] Sin[t])/Sqrt[       1.625 + 0.375 Cos[t]], (- Cos[t/2] Cos[t] -         0.5 Sin[t/2] Sin[t])/Sqrt[1.625 + 0.375 Cos[t]], 1/Sqrt[       1.625 + 0.375 Cos[t]]}          Cross[B[t], T[t]]      After using `Simplify`, I get: > `{((1.4142135623730951 + 1.4142135623730951 Cos[t/2]^2) Cos[t] + > 0.3535533905932738 Sin[t]^2)/( Sqrt[1.625 + 0.375 Cos[t]] Sqrt[ 3 + > Cos[t]]), ((1 + Cos[t/2]^2 - 0.25 Cos[t]) Sin[t])/( Sqrt[0.8125 + 0.1875 > Cos[t]] Sqrt[3 + Cos[t]]), (0.7071067811865476 Sin[t/2])/(Sqrt[1.625 + 0.375 > Cos[t]] Sqrt[3 + Cos[t]])}` I know for a fact that: $$1.4142135623730951 \approx \sqrt{2} \\\ 0.7071067811865476 \approx \frac{\sqrt{2}}{2} \\\ 0.3535533905932738 \approx \frac{\sqrt{2}}{4}$$ When I write `Sqrt[2]`, `(Sqrt[2]/2)` and `(Sqrt[2]/4)` instead of these numbers, I am unable to proceed with these calculations, and I keep getting the warning: ![enter image description here](http://i.stack.imgur.com/cqolT.png) etc. Can someone tell me how to solve this? * * * I didn't know what tag or specific title to put here, so if you have a better idea, feel free to edit it.


A problem with Timing

With               M = Partition[Range@10000000, 1000];       V = Range[10000] - 1;      I got the following timings:               Table[Prepend[M, V]; // Timing // First, {10}]      > {0.358802, 0.561603, 0.546003, 0.546003, 0.577203, 0.592803, \ 0.561603, > 0.577203, 0.561603, 0.561603} I was irritated by the fact that the first timing (0.358802) was significantly faster than the others. This also happened with similar functions and other sizes of `M` and `V`. Later I found the timing function recommended here:               timeAvg =        Function[func,         Do[If[# > 0.3, Return[#/5^i]] & @@ Timing@Do[func, {5^i}], {i, 0,           15}], HoldFirst];      Using it I now get a much "better" result:               Table[Prepend[M, V]; // timeAvg, {10}]      > {0.574083, 0.514803, 0.577203, 0.561603, 0.546003, 0.546003, \ 0.561603, > 0.546003, 0.546003, 0.530403} Why the initial jump with the inbuilt `Timing`?   Should I always use `timeAvg`?


Creating complex contour plots

I would like to create a contour plot of $e^z-\dfrac{z-1}{z+1}$ that looks like the picture on the left, but can only manage the one on the right. I have tried incrreasing the number of contours, but this doesn't have any effect. Am I missing something fundamental? ![](http://i.stack.imgur.com/6Lgxa.gif) ![](http://i.stack.imgur.com/ulwmr.gif)               Show[Table[ContourPlot[{Im[E^(x + I y) - ((x + I y) - 1)/(x + I y) + 1] == k,      Re[E^(x + I y) - ((x + I y) - 1)/(x + I y) + 1] == k}, {x, -4, 4}, {y, -20, 20},      ContourStyle -> {Directive[{Red}], Directive[{Blue}]},      PlotPoints -> 100, Contours -> 20, AspectRatio -> Automatic], {k, -10, 10, 2}]]      The plot I am trying to recreate is from this website (specific PDF).


Proper EdgeForm setting so boundary appears entirely within shape

I have two neighboring (complicated) polygons that I want to be displayed with thick boundaries, however the two shapes border one another, and as EdgeForm places the line centered upon the polygon's boundary, the border of one shape overlaps the other. I would like the boundary lines to lie interior to the polygon's boundaries. Here's shape 1, shape 2, and then the two shapes shown together: ![enter image description here](http://i.stack.imgur.com/B81Zm.png) ![enter image description here](http://i.stack.imgur.com/Ls4vr.png) ![enter image description here](http://i.stack.imgur.com/NlojD.png) Obviously one could just shrink the shapes by a little bit, but this is not very exact. I was thinking a clever EdgeForm definition might be able to "offset" the boundary to the shape's interior.


FindFit with parameters which are simultaneously in initial conditions

I have RLC circuit. I would like to find R and L by using FindFit, but L is in initial condition and I have problem with it. Could you help me ?               c = 116*10^(-6); U = 16000. ;           data =      {        {0, 0}, {0.25*10^(-6), 132000}, {0.5*10^(-6), 330000}, {1*10^(-6), 462000},         {2*10^(-6), 600000}, {3*10^(-6), 462000}, {4*10^(-6), 330000}, {5*10^(-6), 66000},         {6*10^(-6), -198000}, {7*10^(-6), -264000}, {8*10^(-6), -198000}, {9*10^(-6), -132000}     };          lp = ListPlot[data, PlotRange -> All]          fit =        FindFit[data,         First[i /.            NDSolve[{i''[t] + R/L * i'[t] + 1/(c L)*i[t] == 0, i[0] == 0, i'[0] == U/L},              i, {t, 0, 9*10^(-6)}]],         {{R, 10*10^(-3)}, {L, 20*10^(-9)}},          i,          PrecisionGoal -> 4,          AccuracyGoal -> 4]


How to factorise a variable out of an indefinite sum?

(I should start by saying I'm a total beginner with Mathematica, so if the answer needs code I'll need it spelled out quite clearly, the learning curve for this is proving steep!) Basically what I am trying to so is manipulate a power series for an expression involving the function alpha(r) inside an indefinite sum, so that I can pick out coefficients from it (series solving an ODE, for context). The following code is used to produce alpha and then the sum of squares of its first derivative.               α[r_] := Sum[Subscript[α, i, j]*r^i, {i, 0, 5}]          η[r_] :=        Sum[D[α[r], r]^2, {j, 1, N}] /. Sum[x_, y_] :> (Sum[#, y] & /@ Expand @ x)      Without `/. Sum[x_, y_] :> (Sum[#, y] & /@ Expand@x)`, the output stays all collected into one sum over `j` even when `Expand` is applied, shown below: ![Fig 1](http://i.stack.imgur.com/fevwV.png) With that code, the sum splits up into a series of sums, each only one term long: ![Fig 2](http://i.stack.imgur.com/KQzRF.png) However, the variable `r` is still _inside_ the sum in each case, meaning that when I apply `Coefficient[,r,2]` (etc) to the output, it just spits out all of the output (i.e. doesn't do anything) rather than just identifying the terms of the correct power of `r`. What I really need is some code that pulls the 'r' factor out of each summation term, so that `Coefficient` will pick out the required terms.


Expression for evaluating multiple functions?

I am constructing 3D data points for a plot and corresponding to specific conditions "manually". I define the values of five parameters [these I always have to define myself]. From those, I evaluate the values of seven other parameters [some of which are also functions of each others, so I need to be careful with order of evaluation]. Currenly this is how I do it [parameters are functions of values and other parameters]:               par1cond1 = par1[val1, val2, val3];     par2cond1 = par2[val1, val2, par1cond1, val4];     ...     par7cond1 = par7[val1, par6cond1];        And I assign these as the parameters of a vector.               vector1[t_] := {vx[par1cond1, ..., t], vy[par1cond1, ...,t], vz[par1cond1, ..., t]};      In short --- how do I define a function that only takes as its variables the five original parameters, and evaluates the seven relevant expressions in a certain order, and returns the values it got? I would like to do it by calling one function, that would do the manual labour for me:               ConstructVectorFrom[val1, val2, val3, val4, val5]      Which would return the vector.


Problems with series of generalized hypergeometric functions

I have been trying to do the following series:               Series[HypergeometricPFQ[{1, 4, 4}, {4 - Sqrt[3], 4 + Sqrt[3]}, z],{z,1,0}]      Mathematica says that the result is infinite, without telling me precisely how it diverges with 1-z. I have tried FunctionExpand, FullSimplify and other commands, but so far, with no success. Any help would be most welcome. Best, Jorge


How can I invert the colors in a color bar

I have this _Mathematica_ code               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, Subscript["R", "min"]}, {None, None}},        LabelStyle -> Directive[FontFamily -> "Helvetica", 17],        FrameTicks -> {{None, All}, {None, None}},        FrameTicksStyle -> Directive[FontFamily -> "Helvetica", 15, Plain],        ColorFunction -> colorFunction]          Mn = 250; cn = 0.25;     Md = 7000; b = 6; a = 3; h = 0.2;     υ0 = 20; β = 1.5; ch = 8.5;     Lz = 10;     E0 = 600;          Vn = -Mn/Sqrt[R^2 + z^2 + cn^2];     Vd = -Md/Sqrt[b^2 + R^2 + (a + Sqrt[h^2 + z^2])^2];     Vh = υ0^2/2 Log[R^2 + β*z^2 + ch^2];     Vt = Vn + Vd + Vh;     Veff = Vt + Lz^2/(2*R^2);          f[R_, pR_] := 1/2*pR^2 + Veff /. {z -> 0};          plrange = {{0, 13.5}, {0, 47}};     valrange = {0, 6};          C0 =        ContourPlot[Evaluate[f[R, pR]], {R, 0.001, 15}, {pR, 0, 50},          Contours -> {E0}, ContourStyle -> {{Black, Thickness[0.005]}},          AspectRatio -> 1, ContourShading -> False, PlotPoints -> 200,          PerformanceGoal -> "Speed", PlotRange -> plrange];          With[{opts = {ImageSize -> {Automatic, 550}}, cf = "Rainbow"},        Row[{Show[         ListPlot[List /@ data[[All, {1, 2}]],            PlotStyle -> ({PointSize[0.01], ColorData[cf][1 - #]} & /@              Rescale[data[[All, 3]], valrange]),           PlotRange -> plrange,            AspectRatio -> 1, Frame -> True, RotateLabel -> False,            Axes -> None, FrameTicks -> True,            FrameLabel -> {"R", OverDot["R"]},            LabelStyle -> Directive[FontFamily -> "Helvetica", 17],            ImagePadding -> {{60, 20}, {60, 20}}, opts],         C0],          Show[colorbar[valrange, cf],           ImagePadding -> {{20, 60}, {60, 20}}, opts]}]]      I inverted the "Rainbow" color scheme using               {..., ColorData[cf][1 - #]}&      and produced the following nice plot. ![enter image description here](http://i.stack.imgur.com/FPHJi.jpg) However, I can't find a way to invert the colors in the color bar. To be more specific, according to my data red should correspond to 0 of Rmin and deep purple to 6. I hope it is easy to invert the order of the colors in the color bar. Can someone tell me how?


Parallel numerically integrated function can't be plotted

I've been working on a problem where I need to integrate a function numerically. The function is quite complex and it takes almost an hour for _Mathematica_ to make a plot. To speed the process up I thought that I could implement a parallel NIntegrate function using _ParallelTable[]_. I believe I successfully accomplished that for single numerical values for the limits of the integration but there's something wrong since when I try to make a plot I got a bunch of errors. Here's my code, where instead of my horrible integrand I used the function $f(x)=x$               ParalellNIntegrate[imin_?NumericQ, imax_?NumericQ] :=       (step = (imax - imin)/4;        Total[         ParallelTable[          NIntegrate[u, {u, i, i+step}], {i, imin, imax - step, step}]         ]);     Plot[ParalellNIntegrate[0, x], {x, -1, 1}]          (kernel 2) NIntegrate::nlim: u = 0.25 x is not a valid limit of integration.          (kernel 1) NIntegrate::nlim: u = 0.75 x is not a valid limit of integration.          (kernel 2) NIntegrate::nlim: u = 0.5 x is not a valid limit of integration.          (kernel 1) NIntegrate::nlim: u = x is not a valid limit of integration.          (kernel 2) NIntegrate::nlim: u = i+0.25 x is not a valid limit of integration.          (kernel 1) NIntegrate::nlim: u = i+0.25 x is not a valid limit of integration.          (kernel 1) General::stop: Further output of NIntegrate::nlim will be suppressed during this calculation.          (kernel 2) General::stop: Further output of NIntegrate::nlim will be suppressed during this calculation.      Can somebody help me? PS: I also have this doubt about the step and I think I could use this post to clear it (I do realize that I shouldn't post more than one question per post but it's somehow related and it seems silly to open a post just for this). I divided the interval of integration in 4 regions since my cpu only works with 4 threads could somebody tell me if I'm thinking correctly?


How to zoom and pan a ListLinePlot?

I'm using `ListLinePlot` inside a `Manipulate` function to display some data. I've seen that _Mathematica_ allows zooming and panning but it's either only for 3D plots or it just doesn't work with `ListLinePlot`. I've also seen a thread here on Stackexchange for a custom function to zoom and pan but it doesn't seem to work when I apply it to `ListLinePlot` (error message "... is not a graphics primitive or directive"). So is there a solution I've missed to be able to zoom and pan a `ListLinePlot`?


Find patterns in a list

again, I have a list like this:               list={0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, \     0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, \     0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, \     0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0}      I want to search for the pattern: **{1,0,0}** and mark all the numbers matching this sequence in Red with the Style option. I tried to use Cases to help me out, which does not work. Checked the help a few times, but no idea so far :/               Cases[list, {1,0,0}]


Backtrack function

I am using Mathematica 9. In the Help help file is the built-in function Backtrack. In order to use it the Help file says: To use Backtrack, you first need to load the Combinatorica Package using `Needs["Combinatorica`"]`. However, when I try to do this I get > General::compat: Combinatorica Graph and Permutations functionality has been > superseded by preloaded functionality. The package now being loaded may > conflict with this. Please see the Compatibility Guide for details. The "Compatibility Guide" doesn't seem to help. Can someone tell me exactly what is going on here?


Pattern matching not going over a list when using default values

if I execute the following command in Mathematica:               {a,a^2,a^3}/.a^(n_:1)->b^(2 n)      Mathematica returns:               {b^2,b^4,b^6}      but if I enter:               {a,a^2,a^3}/.a_^(n_:1)->b^(2 n)      Mathematica only returns:               b^2      Without the default value for n, Mathematica returns in both instances (a & a_):               {a,b^4,b^6}      Could someone explain why the different behavior?


Problem printing what appears in my notebook

I have created a dashboard that looks fine on my screen and fits onto my screen at 100% magnification on Mathematica. When I try printing it, no matter what printing environment I use, I can not get it to print what is on the screen on a single or two consecutive A4 pages. Depending on the printing environment selected, it prints out either some of the page but not all of it, or prints out the page magnified a few times so that it ends up taking up about 8 A4 pages. When I click on Page Setup, nothing happens. I have also tried exporting to PDF first but the export ends up looking exactly as the printed version did. Here is the code: \--Some functions               GraphHeading[GraphLabel_] :=        TextCell[GraphLabel, FontWeight -> Bold, FontFamily -> "Helvetica"];     DropDownBoxHeading[BoxHeading_] :=        TextCell[BoxHeading, FontWeight -> Bold, FontFamily -> "Helvetica"];      \--Some Definitions               Tab3DropDownOpUSelection = "Haul Trucks";     Tab3DropDownMetricSelection = "Fuel";     Tab3DropDownOperationalUnit =        PopupMenu[        Dynamic[Tab3DropDownOpUSelection], {"Haul Trucks", "Loaders",          "Haul Trucks and Loaders", ""}];     Tab3DropDownMetric =        PopupMenu[        Dynamic[Tab3DropDownMetricSelection], {"Fuel", "Costs",          "Consumption Index", "Cost per Tonne"}];     Tab3MetricList = {"Fuel", "Costs", "Consumption Index",         "Cost per Tonne"};      \--Some things to display               Tab3Graph :=       Dynamic[ListLinePlot[{{{1, 0.96`}, {2, 0.6900000000000001`}, {3,            1.11`}, {4, 1.`}, {5, 1.3900000000000001`}, {6,            1.1500000000000001`}, {7, 1.3800000000000001`}, {8, 1.51`}, {9,            1.1500000000000001`}, {10, 0.51`}}, {{1, 1.06`}, {2, 0.75`}, {3,            1.22`}, {4, 1.1`}, {5, 1.53`}, {6, 1.27`}, {7, 1.52`}, {8,            1.6600000000000001`}, {9, 1.27`}, {10, 0.56`}}},         PlotMarkers -> Automatic,         PlotRange -> {{1, 10}, {0, 1.8260000000000003`}},         AxesOrigin -> {1, Automatic},         Frame -> {{True, False}, {True, False}},         PlotLabel -> "Haul Truck Fuel",         FrameLabel -> {"Week", "Litres", "", ""}, AspectRatio -> 1/3.5,         ImageSize -> {800, 300}, PlotStyle -> {Black, Black}]]     Tab3Stats1Table :=       Grid[{{"Metric", "Unit", 1, 2, 3, 4, 5, 6, 7, 8, 9,          10}, {"Predicted Fuel", "Mlitres", 1.01`, 0.72`, 1.16`, 1.05`,          1.46`, 1.21`, 1.45`, 1.58`, 1.21`,          0.53`}, {"Upper Predicted Fuel", "Mlitres", 1.06`, 0.75`, 1.22`,          1.1`, 1.53`, 1.27`, 1.52`, 1.660000, 1.27`,          0.56`}, {"Lower Predicted Fuel", "Mlitres", 0.96, 0.6900000,          1.11`, 1.`, 1.3900, 1.1500, 1.38000, 1.51`, 1.15000,          0.51`}, {"Material Handled", "Mtonnes", 3.29`, 2.39`, 3.83`,          3.14`, 4.`, 3.2600000000000002`, 3.81`, 4.21`, 3.12`, 1.42`}},        Alignment -> Left,        Dividers -> {{Black, Black, Black, Gray, Gray, Gray, Gray, Gray,           Gray, Gray, Gray, Gray, Gray, Gray, Black}, {Black, Black, Gray,           Gray, Gray, Gray, Gray, Black}}]      \--Putting it all together               Tab3 := Column[{Row[{GraphHeading["Most Recent Update Week is Week "],            GraphHeading[10], " - ", GraphHeading[2013]}],          Column[{Grid[{{"Operational Unit",               "Metric"}, {Tab3DropDownOperationalUnit,               Tab3DropDownMetric,}}, Alignment -> Left], Tab3Graph,            Tab3Graph, Tab3Graph,            Grid[{{"         "}, {"Totals for Selected Week"}, {Dynamic[               Tab3Stats1Table]}, {"           "}},             Alignment -> {Left, Top}],            Column[{"Weekly Measures", Dynamic[Tab3Stats1Table]}]}]},         Alignment -> Center];      \--Use this to generate what is to be display and then hide the code and simply try to print the display.               Dynamic[Tab3]


Non-linear scaled X axis in DateListPlot

I have a lot of plots like this in Mathematica: ![enter image description here](http://i.stack.imgur.com/ZHnYe.png) And I would like to transform it in something like that: ![enter image description here](http://i.stack.imgur.com/S0HeI.png) Where the information between 0 and 7 hours and 18 and 00 hour is "compressed" in the chart. I know about `ScalingFunctions`, but it doesn't work for `DateListPlot`. Here is some toy code to reproduce the original version behavior:               dtIni={2013,1,1,0};     dtFim={2013,1,1,24};     data={#,RandomVariate[NormalDistribution[0,1]]}&/@RandomReal[{AbsoluteTime@dtIni,AbsoluteTime@dtFim},500];          DateListPlot[data         ,FrameTicks->{Automatic,{DateRange[dtIni, dtFim, "Hour"],None}}         ,GridLines -> {If[MemberQ[{0,7,12,18},Last@#],{#,Gray},{#,LightGray}]&/@DateRange[dtIni, dtFim, "Hour"],{#,LightGray}&/@{0.5,1,2,5,10,20}}         ,DateTicksFormat->{"Hour"}     ]      I don't know if the best idea is try to scale the X axis, or join 3 charts, one for each time period using something like this dismembered data:               dataP1 = Select[data, #[[1]] < AbsoluteTime@{2013, 1, 1, 7} &];     dataP3 = Select[data, #[[1]] > AbsoluteTime@{2013, 1, 1, 18} &];     dataP2 = Complement[data, dataP1, dataP3];      I think that the axis scale solution appear to be more elegant, but I don't know how to implement it. 3 Graphics join will be welcome too. Any Clue?


speed up for computing MatrixExp

My code use two method to computing `MatrixExp`, I expected the second snippet code will faster than the first one, but in fact it a bit slower than that. How can I imporve my code?               nnx = 100;     pp = RandomReal[{-1, 1}, 2 {nnx, nnx}];     {n, q, num} = {2, 3, 16};     (*-------------------------*)     t1 = AbsoluteTime[];     {nn, nn} = Dimensions[pp];     a = Sum[((2^-num)^i MatrixPower[pp, i])/i!, {i, n*q}];     res1 = IdentityMatrix[nn] + Nest[(2 # + #.#) &, a, num];     AbsoluteTime[] - t1     (*-------------------------*)     t1 = AbsoluteTime[];     {nn, nn} = Dimensions[pp];     pp1 = 2^-num*pp;     QQ = MatrixPower[pp1, #] & /@ Range[q];     NN = MatrixPower[pp1, q*(# - 1)] & /@ Range[n];     a = Sum[NN[[nn]].QQ[[qq]]/(qq + (nn - 1)*q)!, {nn, n}, {qq, q}];     res2 = IdentityMatrix[nn] + Nest[(2 # + #.#) &, a, num];     AbsoluteTime[] - t1     (*-------------------------*)     res1 - res2 // Chop // Flatten // Union     res1 - MatrixExp[pp] // Chop // Flatten // Union


What Cell Option Controls Group Indentation?

I am working on a stylesheet for a handout I am making and I want to make my own "definition" box format. So I use the "Format"->"Edit Stylesheet" menu option and get the stylesheet inspector. I then type in the name of my new stye name "DefinitionBox" and give it the style that I want. The problem is that when I apply this style it doesn't indent withing the group (ie Section or Subsection) it is in, instead it just spans the full window. For the life of me I can't figure out what option controls this. Any suggestions?


Function derivatives in arbitrary dimension

I have a higher dimensional function: $$f(x,t)=-\ln(t)-\ln(1-\left\|x\right\|^2-t^2)$$ where $x\in\mathbb{R}^n,~t\in\mathbb{R}$. I want to compute the derivatives with the commands               D[f, xi]     D[f, t]     D[f, xi, t]       and higher, to check my own computations which I do by hand. I dont know how to define the function $f$ to apply the commands. Im new _Mathematica_ user and I've not found a right solution Documentation Center.


Emacs key bind on Mathematica Linux

This might not be _Mathematica_ specific question but if there is anyone who can use Emacs keybind on Ubuntu Linux, would you share how you realize it? I'm using _Mathematica_ student edition both on Mac OS X (10.7.3) and Ubuntu (11.10), and Mac version allows basic Emacs keybind (`Ctrl`+`a`, `Ctrl`+`e`, `Ctrl`+`d`, `Ctrl`+`f`, `Ctrl`+`b`, etc.) In general, GUI programs on my Ubuntu doesn't allow Emacs keybind unless explicitly configured per program, so as I said I might have to look for general solution for Ubuntu/Linux. But I welcome whatever the solution to realise the keybind. * * * _Update:_ Thanks to @sebhofer's answer, I manage to comfortably use Emacs keybind on Ubuntu. I had to modify both `MenuSetup.tr` and `KeyEventTranslations.tr` to enable my preferred keybind. As a reference for other people who may want to enable Emacs keybind, I'm sharing those 2 files here: http://goo.gl/nJaXD and http://goo.gl/gZWS5, which allow following keybinds:               C-v "ScrollPageDown"     C-d "DeleteNext"     C-h "DeletePrevious"     C-p "MovePreviousLine"     C-n "MoveNextLine     C-b "MovePrevious"     C-f "MoveNext"     C-t "MoveNextWord"     C-i "MovePreviousWord"     C-e "MoveLineEnd"     C-a "MoveLineBeginning"      Some of the above might not be the standard Emacs keys. Also, more importantly, some default keybinds that use `alt` might not work due to the change (I haven't tested thoroughly). You can customize by modifying those `.tr` files.


Unicode-aware string functions?

I've recently discovered that `ToUpperCase` is quite unreliable on non-ASCII input: ![see code below](http://i.stack.imgur.com/my6SR.png)               In[31]:= ToUpperCase@{"éàÇœßþσς", "ĳķǌđӽծ", "ÿ"}     Out[31]= {"ÉÀÇŒSSÞ∑∑", "ĳķǌđӽծ", "Y"}      So: it handles some accented ASCII, ligatures, Western European stuff, greek and cyrillic, while it fails on others (returning the lowercase characters themselves when they have valid uppercase variants). In at least one case, it fails utterly (the uppercase version of `ÿ` is `Ÿ`, not `Y`). Mathematica’s documentation is very short on specifics on Unicode support. It broadly states that: > Mathematica has efficient systemwide 16-bit Unicode support, allowing a full > range of international, technical and other character sets and character > encodings. which of course I very much doubt after seeing the above. More specifically, the `ToUpperCase` doc does not include a mention of Unicode. * * * So, after that bleak assessment, the question is the following: **how do I get better Unicode-compliant string manipulation functions?** (mostly `ToUpperCase` and `ToLowerCase` for now, but I'm sure others will be a problem for me in the future). Are there internal functions that do this, or external packages? Have I missed something in M’s documentation? * * * _On a humorous note:_ the documentation for `ToUpperCase` even uses my example of a buggy transform (`ÿ`) in an example. It is, however, used about an unrelated issue, to warn users that “for a few characters, ToLowerCase is not the inverse of ToUpperCase” (as might be expected by Unicode-unaware programmers): ![enter image description here](http://i.stack.imgur.com/NvSl2.png) * * *


Looking for a package regarding Schur Polynomials and Kostka numbers

I'm currently looking for any Mathematica package that involves Schur polynomials and/or Kostka numbers. More generally, I'd be happy with anything that expands on symmetric polynomials in general. Does such a thing exist? I've had no luck finding any.


Iteration of a function

I have a function $f(x)=x^7+k$ I want to iterate $xn+1=g(xn)$, 50 times starting with $x0=1$ and keep the last 10 values I want to assign these values to a function `y` and be able to use `y` to calculate this iteration for any input constant $k$, eg $k=0$, $k=0.1$, then store all the corresponding 10 values I have extracted for $k=0$, $k=0.1$, up to 1 in a table. Is this possible? I can't figure it out. I have only done this and I am stuck: `Take[NestList[f, 0, 50], -10]`


Show parameters on graph

I am graphing the 4 PDFs for a distribution for 4 different parameters in the same graph. I want the values of the parameters to be shown in corner of the graph. How do I do this?


Manipulate not working inside DialogInput

Some controls do not appear to work with `Manipulate` inside a `DialogInput`. For example:               DialogInput[{Manipulate[x, {x, {1, 2, 3}}], DefaultButton[]}]      does not work, but the slider version:               DialogInput[{Manipulate[x, {x, 1, 3, 1}], DefaultButton[]}]      does work. Is this a bug or am I missing a vital option setting?


Solve within a range?

Is it possible to solve an equation in which some some of the parameters have defined ranges? Example:               Solve[x^2 + 0.09149 x + 6.263*10^-6 + kp (10.95 x + 0.9574) == 0 &&            y^2 + 0.09149 y + 6.263*10^-6 + kp (10.95 y + 0.9574) == 0 &&            kp (10.95 z + 0.9574) == 0, {kp}]      where `x < -4` and `y < -5` and `0 > z > -5`. I am trying to solve for variable `kp` and would like to know how the value of `kp` differs for different values of x, y and z which is defined. X and y shall of course have some kind of max value for which it shall evaluate the solve function. Ohh.. one important fact. Kp can't become negative. it's the main reason why i want to to solve it for for changing parameter defined within a range.


Define product derivative

How do I define the $n$th product derivative of a function in _Mathematica_? The first product derivative $f^\ast$ of a function $f$ is $$ f^\ast(x)=\exp\left(\frac{f^\prime(x)}{f(x)}\right) $$ The $n$th product derivative is the result of applying this operator $n$ times. This is my attempt at a recursive definition:               In[111]:= Clear[prodd]     prodd[f_, n_] := prodd[e^(f'/f), n - 1]; prodd[f_, 0] = f          Out[112]= f               In[113]:= prodd[E^x, 1](* Should print E *)          Out[113]= e^(E^-x Derivative[1][(E^x)])          In[114]:= prodd[E^E^x, 1](* Should print E^E^x *)          Out[114]= e^(E^-E^x Derivative[1][(E^E^x)])          In[114]:= prodd[E^x, 2](* Should print 1 *)


MUnit creating a hierarchy of TestSuites

I would like to create a hierarchy of `TestSuites`. However it appears that it is not possible to call a `TestSuite` from another `TestSuite`. So before I go and reinvent the wheel, I thought I would see how others have done (or would) accomplish this. * * * **Details of what I am trying to accomplish** I have grouped packages (and their tests) that perform like functionality by directory. For illustrative purposes lets say I have three subdirectories: importers, manipulators, and processes. I have a TestSuite in each subdirectory named TestAll.mt . I also have one in the top level directory called TestAll.mt that I would like to have call the TestAll.mt in the three subdirectories. I would like to be able to run the test suites at both the subdirectory and top levels. Running the test suite at the subdirectory level would only run the particular subset of tests, while running the test suite at the top level would run the test suites in all the subdirectories. I would like to avoid having to add an entry for a particular test to both the subdirectory and top level test suites. A bonus would be if the top level test suite auto discovered the test suites in the subdirectories (not having to specify the subdirectories in the root test suite), but that is not crucial. ## Update * * * Attempt #1 -- Make a list of .mt files in each of the sub TestAll.mt s. If the top level TestAll.mt is called, the sub levels' lists would be appended to the top level's list and then that list would be supplied to TestSuite. If a sub level's TestAll.mt is called, its list would be supplied as the argument to TestSuite. **Result:** Failure From Workbench, adding any expression to a .mt that contains `TestSuite` appears to cause none of the tests to run.               x=1;     TestSuite[         {             "Test1.mt",             "Test2.mt"         }     ]      From a notebook, `TestSuite` shows up in command completion, but does not show up in the MUnit package usage info. Executing the following:               TestSuite[      {       "/pathToTests/Test1.mt",       "/pathToTests/Test2.mt"       }      ]      Results in:               TestSuite[{"/pathToTests/Test1.mt", "/pathToTests/Test2.mt"}]      Searched the MUnit package files for TestSuite, no hits.               cd "/Applications/Wolfram Workbench.app/configuration/org.eclipse.osgi/bundles/214/1/.cp/MathematicaSourceVersioned/Head/MUnit"     find . -name "*.m" -print -exec grep TestSuite {} \;      * * * Attempt #2 -- Roll my own `TestSuite` ...


Obtaining a thin/compact SVD

I'm using `SingularValueDecomposition` for a least-squares regression, the instruction that works fine for what I need is               SingularValueDecomposition[X,Length[SingularValueList[X]]]      Is there a way to do the same thing but without calling `SingularValueList` as I suppose similar computations are done two times in `SingularValueDecomposition` and `SingularValueList` ?


Singularities using VectorPlot

I am trying to plot a vector function of a fluid flow given by $\vec{V} = (\frac{-\cos(\theta)}{r^2},-\frac{\sin(\theta)}{r^2})$ I am trying to plot it in Mathematica using the command below, I converted to Cartesian coordinates by the way. But this does not run in Mathematica. Without the `Exclusions` option, I only get one arrow at the origin. Can you help me with this plot?               VectorPlot[           {-(x/(x^2 + y^2)^(3/2)), -(y/(x^2 + y^2)^(3/2))},            {x, -1, 1}, {y, -1, 1},            Exclusions -> {(x^2 + y^2)^(3/2) == 0}       ]


Equation solving with GroebnerBasis

I have a system of quadratic equations defined below               nx = 1;     ny = 2;     ne = 1;     nt = 2;     n = nx + ny;     ns = 2;              For[ii = 1, ii <= ns, ii++,           G[ii] = Table[g[ii][i, j], {i, ny}, {j, nx + ne + 1}];           H[ii] = Table[h[ii][i, j], {i, nx}, {j, nx + ne + 1}];           ];              eqns = {-1.1111111111111112` g[1][1,                1] + (-0.9703966865736877` + 1.` g[1][1, 1] + 0.9` g[1][2, 1] +                 0.11111111111111109` g[2][1, 1] +                 0.09999999999999998` g[2][2, 1]) h[1][1, 1],             10.` g[1][1, 1] -              161.` g[1][2,                1] + (143.451` g[1][2, 1] + 15.938999999999995` g[2][2, 1]) h[                1][1, 1],             0.7763173492589502` + 0.6199999999999999` g[1][2, 1] -              0.9703966865736877` h[1][1, 1], -1.1111111111111112` g[2][1,                1] + (-0.9703966865736877` + 0.11111111111111109` g[1][1, 1] +                 0.09999999999999998` g[1][2, 1] + 1.` g[2][1, 1] +                 0.9` g[2][2, 1]) h[2][1, 1],             10.` g[2][1, 1] -              161.` g[2][2,                1] + (15.938999999999995` g[1][2, 1] + 143.451` g[2][2, 1]) h[                2][1, 1],             0.7763173492589502` + 0.13999999999999996` g[2][2, 1] -              0.9703966865736877` h[2][1, 1]};              polys = eqns /. {0. -> 0};      This system has some structure. First, I find the variables               vars = Variables[polys];       Deconstruct the polynomials (I know it is a quadratic system). There are 2 nonzero constant terms, 12 nonzero linear terms, and 12 nonzero 2nd-order terms               {m0, m1, m2} = CoefficientArrays[polys, vars]      Confirm the reconstructed polynomials are the same as the originals (just checking)               polys - (m0 + m1.vars + m2.vars.vars) // Expand // Chop       Of the 12 nonzero 2nd-order terms, of which there are 8 distinct cross- products ...               Flatten[Most[ArrayRules[#]] & /@ m2][[All, 1]] // Union // Length      ... none of which are purely quadratic               Diagonal /@ m2 // Union      So, it is a quadratic system but nothing purely quadratic If I apply `GroebnerBasis`               GBordering =       Flatten[{H[1][[1 ;; nx, 1 ;; nx]], H[2][[1 ;; nx, 1 ;; nx]],         G[1][[1 ;; ny, 1 ;; nx]], G[2][[1 ;; ny, 1 ;; nx]]}]     GB = GroebnerBasis[polys, GBordering];     GB // MatrixForm     soln = Solve[Thread[GB == 0]];     soln // MatrixForm      I get the right solutions. Anyone interested, I will send the code. But you can copy this into your computer and it will give you 9 solutions. Everything OK up to here. But if I make the system a larger (only a little)               nx = 2;     ny = 3;     ne = 1;     nt = 1;     n = nx + ny;     ns = 2;     For[ii = 1, ii <= ns, ii++,       G[ii] = Table[g[ii][i, j], {i, ny}, {j, nx + ne + 1}];       H[ii] = Table[h[ii][i, j], {i, nx}, {j, nx + ne + 1}];       ];     eqns = {9.169301858525786` -          1.` g[1][3,            1] + (-19.453328842995205` + 8.169847955946475` g[1][2, 1] +             0.9077608839940525` g[2][2, 1]) h[1][1,            1] + (0.` + 8.169847955946475` g[1][2, 2] +             0.9077608839940525` g[2][2, 2]) h[1][2, 1],         0.` - 1.` g[1][3,            2] + (-19.453328842995205` + 8.169847955946475` g[1][2, 1] +             0.9077608839940525` g[2][2, 1]) h[1][1,            2] + (0.` + 8.169847955946475` g[1][2, 2] +             0.9077608839940525` g[2][2, 2]) h[1][2, 2], -1.` g[1][3,            1] + (0.` - 1.` g[1][1, 1] + 0.9` g[1][3, 1] -             0.11111111111111109` g[2][1, 1] +             0.09999999999999998` g[2][3, 1]) h[1][1,            1] + (1.0999999999999999` - 1.` g[1][1, 2] + 0.9` g[1][3, 2] -             0.11111111111111109` g[2][1, 2] +             0.09999999999999998` g[2][3, 2]) h[1][2, 1], -1.` g[1][3,            2] + (0.` - 1.` g[1][1, 1] + 0.9` g[1][3, 1] -             0.11111111111111109` g[2][1, 1] +             0.09999999999999998` g[2][3, 1]) h[1][1,            2] + (1.0999999999999999` - 1.` g[1][1, 2] + 0.9` g[1][3, 2] -             0.11111111111111109` g[2][1, 2] +             0.09999999999999998` g[2][3, 2]) h[1][2,            2], -178.88888888888889` g[1][1, 1] -          9.` g[1][3,            1] + (159.39` g[1][1, 1] + 17.709999999999994` g[2][1, 1]) h[1][           1, 1] + (159.39` g[1][1, 2] + 17.709999999999994` g[2][1, 2]) h[            1][2, 1], -178.88888888888889` g[1][1, 2] -          9.` g[1][3,            2] + (159.39` g[1][1, 1] + 17.709999999999994` g[2][1, 1]) h[1][           1, 2] + (159.39` g[1][1, 2] + 17.709999999999994` g[2][1, 2]) h[            1][2, 2],         0.` - 0.21199999999999997` g[1][1, 1] +          0.99` h[1][2, 1], -0.792` - 0.21199999999999997` g[1][1, 2] +          0.99` h[1][2, 2], 0.` + 1.` g[1][2, 1] - 1.` h[1][1, 1],         0.` + 1.` g[1][2, 2] - 1.` h[1][1, 2],         9.169301858525786` -          1.` g[2][3,            1] + (-19.453328842995205` + 0.9077608839940525` g[1][2, 1] +             8.169847955946475` g[2][2, 1]) h[2][1,            1] + (0.` + 0.9077608839940525` g[1][2, 2] +             8.169847955946475` g[2][2, 2]) h[2][2, 1],         0.` - 1.` g[2][3,            2] + (-19.453328842995205` + 0.9077608839940525` g[1][2, 1] +             8.169847955946475` g[2][2, 1]) h[2][1,            2] + (0.` + 0.9077608839940525` g[1][2, 2] +             8.169847955946475` g[2][2, 2]) h[2][2, 2], -1.` g[2][3,            1] + (0.` - 0.11111111111111109` g[1][1, 1] +             0.09999999999999998` g[1][3, 1] - 1.` g[2][1, 1] +             0.9` g[2][3, 1]) h[2][1,            1] + (1.0999999999999999` - 0.11111111111111109` g[1][1, 2] +             0.09999999999999998` g[1][3, 2] - 1.` g[2][1, 2] +             0.9` g[2][3, 2]) h[2][2, 1], -1.` g[2][3,            2] + (0.` - 0.11111111111111109` g[1][1, 1] +             0.09999999999999998` g[1][3, 1] - 1.` g[2][1, 1] +             0.9` g[2][3, 1]) h[2][1,            2] + (1.0999999999999999` - 0.11111111111111109` g[1][1, 2] +             0.09999999999999998` g[1][3, 2] - 1.` g[2][1, 2] +             0.9` g[2][3, 2]) h[2][2, 2], -178.88888888888889` g[2][1, 1] -          9.` g[2][3,            1] + (17.709999999999994` g[1][1, 1] + 159.39` g[2][1, 1]) h[2][           1, 1] + (17.709999999999994` g[1][1, 2] + 159.39` g[2][1, 2]) h[            2][2, 1], -178.88888888888889` g[2][1, 2] -          9.` g[2][3,            2] + (17.709999999999994` g[1][1, 1] + 159.39` g[2][1, 1]) h[2][           1, 2] + (17.709999999999994` g[1][1, 2] + 159.39` g[2][1, 2]) h[            2][2, 2],         0.` - 0.14799999999999996` g[2][1, 1] +          0.99` h[2][2, 1], -0.792` - 0.14799999999999996` g[2][1, 2] +          0.99` h[2][2, 2], 0.` + 1.` g[2][2, 1] - 1.` h[2][1, 1],         0.` + 1.` g[2][2, 2] - 1.` h[2][1, 2]};     polys = eqns /. {0. -> 0};      but with exactly the same structure Find the variables               vars = Variables[polys]      Deconstruct the polynomials (I know it is a quadratic system). There are 10 nonzero constant terms, 228 nonzero linear terms, and 324 nonzero 2nd-order terms               {m0, m1, m2} = CoefficientArrays[polys, vars]      Confirm the reconstructed polynomials are the same as the originals (just checking)               polys - (m0 + m1.vars + m2.vars.vars) // Expand // Chop       Of the 324 nonzero 2nd-order terms, of which there are 180 distinct cross- products ...               Flatten[Most[ArrayRules[#]] & /@ m2][[All, 1]] // Union // Length      ... none of which are purely quadratic               Diagonal /@ m2 // Union      Mathematica cannot handle it. I am not sure whether it is a problem of memory, a problem of speed or something like that. I wounder whether I could take advantage of the quadratic structure without purely quadratic components to simplify the problem and make it possible for Mathematica to handle it.


How can I scale the y axis?

I have a file I import and read into a table of $2 \times n$. I can plot this data using the following code:               directory = "c:\nameofdirectory";     SetDirectory[directory];     filenames = FileNames[];     readlist = ToString[filenames[[1]]];     table = OpenRead[readlist];     data = ReadList[table, {Number, Number}];     Close[table];          ListPlot[data, Frame -> True, PlotRange -> {All, All}, Joined -> True,        FrameLabel -> {"Voltage (V)", "Current (A)"}];      but the $y$-axis is order of $10^{-6} A$. I'd prefer to have my $y$-data scaled by $10^{-6}$ then label my axis is `microA` instead of `A`. I've tried using `Ticks` but I don't really understand how that works (it never changes my plot at all when I use it). If there's no easy way to do this, can someone tell me how to directly divide my $y$-values from the input? I can separate the $y$-values from "data" and divide them using               xdat = List[];     ydat = List[];     For[j = 1, j < Length[data] + 1, j++,         AppendTo[xdat, data[[j]][[1]]];         AppendTo[ydat, data[[j]][[2]]];        ];          y=ydat/10^-6;      but I don't know how to place them back into the form as before so that it can be easily plotted with `ListPlot`.


Using Manipulate to vary the frequency of a sound produced by SoundNote[]

I have tried various ways to combine Manipulate and Sound/SoundNote that would allow me to vary the frequency of a sound while it is being produced. The addition of Dynamic didn't help, but did increase the variety of error messages. Is this just not possible?               Manipulate[EmitSound[Sound[SoundNote[n, 3]]], {n, 0, 10}]      My goal to listen to, or observe, the beat frequencies produced as a tone becomes closer to or further away from twice the frequency of a second, steady tone. My underlying issue is to develop insight into how original idea of an octave.


Building adjacency matrix from set data

I have two sets: games and players. Players pick their games. As such I will have data say g1={p1,p3,p5},g2={p2,p4},g3={p2,p3,p5}. My interest though is to build the connections among players because of the common games they have played. For instance, since p1 played with p3 and p5 in game 1, then they are connected. I can then build an adjacency matrix for the players: {{0,0,1,0,1},{0,0,1,1,1},{1,1,0,0,1},{0,1,0,0,0},{1,1,1,0,0}}.I'll be doing this for hundreds of games and thousands of players. Question is: how do I efficiently get the adjacency matrix given the data? Thanks for the inputs.


How can I replace Polygon by Line in the output of ParametricPlot3D while preserving colours?

{m0, m1, m2, m3, m4, m5, m6, m7} = {4, 3, 2, 3, 6, 2, 6, 4};     r = Sin[m0*phi]^m1 + Cos[m2*phi]^m3 + Sin[m4*theta]^m5 + Cos[m6*theta]^m7;     g = ParametricPlot3D[{r*Sin[phi]*Cos[theta], r*Cos[phi],          r*Sin[phi]*Sin[theta]}, {phi, 0, Pi}, {theta, 0, 2 Pi},         ColorFunction -> (Blend[{Red, Yellow, Green, Cyan, Blue}, #] &),         Mesh -> None, Boxed -> False, Axes -> 0];     g /. Polygon -> Line      gives this: ![enter image description here](http://i.stack.imgur.com/BAssf.jpg) The colour information is gone. I want to get the output below: ![enter image description here](http://i.stack.imgur.com/ukhBI.jpg) How can I get it?


FindRoot: Minimum Execution Time

Is there a minimum execution time for the command FindRoot? If so, can I get rid of it? For example, if I compute the time to solve the fundtion x=0, it takes around 0.27ms per evaluation:               In[581]:= AbsoluteTiming[Do[FindRoot[x, {x, 300}], {try, 1, 100}]]          Out[581]= {0.0270027, Null}      However, this is virtually the same time as it takes to solve a much more complex equation system {x=0,y=0,z=0}               In[580]:= AbsoluteTiming[Do[FindRoot[{x, y, z}, {{x, 300}, {y, 300}, {z, 300}}], {try, 1, 100}]]          Out[580]= {0.0280028, Null}      Since I am running findroot many times (the actual system is more complicated), I care about this "fixed" running cost. Is there a way to get rid of it?


Mapping multiple functions over an array

I am looking for an elegant way to Map multiple functions over an array. My problem looks something like this: Consider a list of functions:               f = {f1,f2,f3,f4} (* example, can be larger *)      And an array:               A = {{a1, b1, c1, d1, e1}, {a2, b2, c2, d2, e2}, {a3, b3, c3, d3, e3}}; (*example, can be larger*)      **Q1:** I’d like to map the functions in f over the array A so that the final result looks like:               B= {{1 - a1, f1[a1]*b1, f2[a1]*c1, f3[a1]*d1, f4[a1]*e1}, {1 - a2,      f1[a2] b2, f2[a2] c2, f3[a2] d2, f4[a2] e2}, {1 - a3, f1[a3] b3,      f2[a3] c3, f3[a3] d3, f4[a3] e3}}      ![Sample input/output](http://i.stack.imgur.com/WdrAF.png) **Q2:** How do I map the functions a little differently so that the output looks like:               c= {{a1, f1[a1] b1, f2[b1] c1, f3[c1] d1, f4[d1] e1}, {a2, f1[a2] b2,      f2[b2] c2, f3[c2] d2, f4[d2] e2}, {a3, f1[a3] b3, f2[b3] c3,      f3[c3] d3, f4[d3] e3}} // tf      ![Alternate mapping](http://i.stack.imgur.com/McXL7.png)


Merging two lists by prepending elements

Being a newcomer to _Mathematica_ , I have the following question. Given               x = Range@9~Partition~3;      and               y = {a, b, c};      I want to combine `x` and `y` so that               result = {{a, 1, 2, 3}, {b, 4, 5, 6}, {c, 7, 8, 9}};      I have written               MapPrepend[a_, b_] := Prepend[a[[#]], b[[#]]] & /@ Range@Length@b      which does the job, but I wonder if there are other, more functional solutions? Probably this question has already been answered. In this case it would be very nice if you just would direct me to the links.


how to create Dataset after importing txt file

I would like to translate a imported txt file to Dataset.               test = Import["E:\\mathematica\\example.txt", "table",             {"FieldSeparators" -> ",", "CharacterEncoding" -> "ASCII"}]      The result is: > {{"naam A", "naam B", "naam C", "naam D"}, {1, 2, 1.2, "a"}, {2, 3, 2.3, > "b"}, {3, 4, 2.3, "c"}, {4, 5, 4.5, "d"}, {5, 6, 5.6, "e"}, {6, 7, 6.7, > "f"}, {7, 8, 7.8, "g"}, {8, 9, 8.9, "h"}, {9, 10, 9.1, "i"}, {10, 11, 10.1, > "j"}} Now I would like to translate it to `Dataset` which is new in _Methematica 10.0_.               dataset = Dataset[{        <|"naam A" -> 1, "naam B" -> "2", "naam C" -> {1.1}, "naam D" -> {a}|>,        <|"naam A" -> 2, "naam B" -> "3", "naam C" -> {1.2}, "naam D" -> {b}|>,        <|"naam A" -> 3, "naam B" -> "4", "naam C" -> {1.3}, "naam D" -> {c}|>,        ....        }]      I tried it with the next code:               data = Dataset[<|"key1" -> test[[All, 1]], "key2" -> test[[All, 2]],         "key3" -> test[[All, 3]], "key4" -> test[[All, 4]]|>]      This code gives the wrong output. Anyone a suggestion how to do it?


Dealing with numbers too large for machine precision in Graphics

`Graphics` only supports machine precision numbers (i.e. number that can be converted to machine precision). Take for example               Graphics[Point[{0, Exp[1000.]}]]      which produces an error because `Exp[1000.]` is too large to be representable as a `double`. What is the _simplest_ way to deal with situations like this? Replacing all too large numbers with just some arbitrary very large machine precision number is fine, as they'll be outside the plot range anyway. I'm sure there must be some built-in function that can fix this easily.


Why is my plot cut off?

I am trying to use `Show` to combine two plots so I do the following:               g1 = Plot[x, {0, 100}, AspectRatio -> 1]     g2 = ListContourPlot[data, FrameLabel -> {"label1", "label2"},        PlotLabel -> "title", AspectRatio -> 1,        DataRange -> {{0, 100}, {0, 100}}]          g3 = Show[{g1, g2}]      Everything looks great on the computer. Now, I want to export.               Export[g3, "test.pdf", ImageResolution -> 600]      This creates a problem. The y-axis label is completely missing. The image is cut off on the left-hand side. It's not white space or anything like that. It's just not there. The whole left side of the image is missing. The title of the plot is partially cut off too. How do I fix this?


Sort per column

I have some data:               data={{"a", 1, 1}, {"a", 1, 2}, {"a", 1, 3},            {"c", 2, 1}, {"b", 2, 2}, {"b", 2, 3},            {"c", 3, 1}, {"a", 3, 2}, {"a", 3, 3}}      When I use:               Sort[data]      I get the list ordered in incremental order first with column 1 then by 2 and last by the third. Suppose I want the first column in increasing order but the second in decreasing order and the third again in increasing order. How do I do that. I tried with Sort and SortBy but that doesn't work. Output should be: > a 3 2 > > a 3 3 > > a 1 1 > > a 1 2 > > a 1 3 > > b 2 2 > > b 2 3 > > c 3 1 > > c 2 1 It's probably a simple question but apparently not obvious to me.


Simplify function with normalized vector

I made a very simple case:               testF[x_, y_, z_] = x^2 + y^2 + z^2     Simplify[testF[x, y, z]]      If {x, y, z} is normalized, the simplified result should just be 1. How could I specify this condition/assumption?


"Off-label use" of Mathematica functions for performance

Assisting an acquaintance with a simulation where a very large number of binomial probability calculations are required, I pointed them to a slightly obscure function to dramatically speed up their algorithm. Specifically, for               Probability[x == b, x \[Distributed] BinomialDistribution[n, p]]      the same result can be had with               BernsteinBasis[n, b, p]      but the latter is 15-20X faster (and surprisingly generally more accurate with inexact _p_ ) than the former, and 1.5-2X faster than _PDF_ calculation. Only explicit calculation using the formula for binomial probability is faster. I'm curious what other "off-label" uses of built-in functions have been noted to have performance advantages.


Numerically solving a 2D oscillating integral

I'm having trouble solving this integral numerically:               Integrand2 :=  I/λ Holo[ξ, η] E^(I (2 π)/λ r)/r     ResultsTable2 = Table[NIntegrate[Integrand2, {ξ, -20, 20}, {η, -20, 20},           Method -> "MultidimensionalRule"], {x, -15, 15, 5}, {y, -15, 15, 5}]      The function called `Holo` is modelling an aperture that looks like this: ![enter image description here](http://i.stack.imgur.com/gE7Zo.jpg) To put it simply: I'm trying to do _Fresnel_ diffraction with this as the aperture. My goal is to get a 2D inverse _Fourier transform_ by summing over the entire `Holo` term (a function of `ξ` and `η`). As you can see from the image, it oscillates rapidly, so unless I integrate over a very small area of `ξ` and `η`, I get the following error: > NIntegrate::slwcon: Numerical integration converging too slowly; suspect one > of the following: singularity, value of the integration is 0, highly > oscillatory integrand, or WorkingPrecision too small. To get a good 2D inverse _Fourier transform_ , I need to have a larger area. Ideally, integrating over 100 by 100 would be good. Is there some kind of method or work around that can make this happen? I can provide more details if needed. I'm new to _Mathematica_ and to this site, so any answer is appreciated. I can learn from any comments or suggestions you have :) EDIT: I guess to make my question a bit clearer: _how can I numerically integrate a 2D oscillating function?_


Point belonging to a Disk in a Cartesian Coordinate System

The image below represents a human subject fixations while observing this abstract pattern for 3 seconds. I would like to know how much time they spent looking at the actual disk. That is a red point within a Black Disk. ![enter image description here](http://i.stack.imgur.com/GcxFx.png) Each fixations (each sublist of "fixations" below is coded as such : {{X,Y},Duration in ms}                fixations=      {{{20.3899, 14.8931}, 238}, {{27.0063, 18.8899},428},        {{25.8113, 24.8679}, 377}, {{24.2579, 22.022},106},        {{25.3208, 24.022}, 130}, {{21.739, 12.1792},175},        {{29.2673, 8.88994}, 295}, {{30.3868, 17.6572},160},        {{31.217, 22.6761}, 145}, {{22.9686, 20.6918},155},        {{19.6321, 20.2704}, 145}}      Each Disk is coded as {X,Y,R}                Disks=      {{22.8176, 19.9696, 0.974938}, {29.5314, 10.7197, 0.974938},        {17.5112,19.7207, 0.974938}, {30.8997, 23.2454, 0.974938},       {28.0588,6.09759, 0.974938}, {30.8524, 17.0661, 1.53205},        {21.0393, 10.7137,1.53205}, {25.451, 25.1336, 1.53205}}      How could I : -Count the number of fixations that are within a disk. -Then how much actual time they spent there.  The only solution I thought about was to compute the EuclideanDistance of each fixation to each disk but I feel there is a smarter faster way to do this. THank You for your attention.


Throwing away all expression on a loopback link

What is the simplest way to throw away all expressions waiting to be read on a loopback link, effectively resetting the link? I am building an expression on a loopback link using the C MathLink interface. If the operation succeeds, I want to send the expression to `stdlink`. If it fails, I need to _clear_ the loopback link. What is the recommended way to do this?


Problem with general assumptions

I hope I am not to redundant with my questions. As part of solving a physical problem, I want to assume once and for all that all my variables and parameters are real, positive and finite. Is it possible make such assumptions for all _Mathematica_ functions? I tried this piece of code I found on the forum:               $Assumptions = Element[_, Reals] && {_ ∈ Reals} && {_} > 0;      But still, `Sign` does not aways return 1, `Minimize` does not treat all parameters as negative, etc.


Define a mathematical set

I have a terribly short question: Is there a way to define a pure mathematical set? I tried a bit of googling, but the word "set" has two meanings and the other one (as in setting) as by far more dominant and I couldn't find any reference to mathematical sets in _Mathematica_. As for the application, I would like to be able to define two sets `A`, `B` and test whether the two sets are the same or not, namely have the same elements.


Using ParametricNDSolveValue with initial conditions of another ParametricNDSolveValue

I have a system of parameter-dependent ODEs, which I can solve using `ParametricNDSolveValue`. Now, I have another ODE, which has as initial condition the solution of one component of the first system at a specific time point. Consider the example               pfun = ParametricNDSolveValue[{x'[t] == a*x[t], x[0] == 1}, {x}, {t, 0, 10}, {a}];     qfun = ParametricNDSolveValue[{y'[s] == a^2*y[s], y[0] == First[pfun[a]][2]}, {y}, {s, 0, 10}, {a}];      Then,               qfun[4]      gives the output: _ParametricNDSolveValue::ndinnt: "Initial condition 4.[2.] is not a number or a rectangular array of numbers"_. This is odd, since `First[pfun[.5]][2]` produces $2.71828$ as output, as one expects. However, omitting the curly brackets of `x` in the first line gives the correct result:               pfun = ParametricNDSolveValue[{x'[t] == a*x[t], x[0] == 1}, x, {t, 0, 10}, {a}];     qfun = ParametricNDSolveValue[{y'[s] == a^2*y[s], y[0] == pfun[a][2]}, {y}, {s, 0, 10}, {a}];     First[qfun[4]][2]      produces the output $2.35385*10^{17}$, which is $\exp(2a)\exp(a^2s)$ for $a=4$ and $s=2$. As mentioned, `pfun` is a _system_ of equations in the real problem, so omitting curly brackets is no option for me. Any ideas? **UPDATE** I found out that the problem with the first two lines of code is that the fragment `First[pfun[a]]` is first evaluated with `a` having no value, thus `First[pfun[a]]` reduces to `a`. How can I specify that `First` is evaluated _after_ `a` is given a specific value?


How to use NDSolve to track a deviation from equilibrium?

i have a task to find a event, to achieve this i think need to integrate until a constant function suddenly breaks the equilibrium and give a sharp peak. I think that EventLocator should work, thus tried the proposals from How to use NDSolve to track equilibrium?, with a threshold, but the numerical calculator is still complaining that the value before and after the step are not real numbers, but this would not be the case in theory, the code:               psi=Pi;     For[i=1,i<141,i++,w[i]=1/2];     fext=1;     k = 35.529;     ci = Table[y[i][0] == RandomReal[{-Pi, Pi}], {i, 1, 141}];     AppendTo[ci,y[0][0] == y[141][0] - psi];          lckm = {y[0]'[t] == fext, y[141]'[t] == fext,Table[y[i]'[t] ==               w[i] +                k (Sin[y[i + 1][t] - y[i][t]] +                   Sin[y[i - 1][t] - y[i][t]]), {i, 1,               140}]};          sol = NDSolve[{lckm, ci},        Table[y[i], {i, 0, 141}], {t, 0.0, 800.0},       WorkingPrecision -> 30, AccuracyGoal -> 15, PrecisionGoal -> 15,        MaxSteps -> Infinity];          v1 = y[140][t] /. sol[[1]];     v2 = y[141][t] /. sol[[1]];     norm = Sin[v1 - v2] /. t -> 800;     k = 35.526;         ci = Table[            y[i][0] ==              Part[{y[i][t] /. sol} /. t -> 800.0, 1], {i, 1, 141}];         AppendTo[ci, y[0][0] == y[141][0] - psi];               lckm = {y[0]'[t] == fext, y[141]'[t] == fext,Table[y[i]'[t] ==           w[i] +            k (Sin[y[i + 1][t] - y[i][t]] +               Sin[y[i - 1][t] - y[i][t]]),{i, 1,           140}]};     sol = NDSolve[{lckm, ci},        Table[y[i], {i, 0, 141}], {t, 0.0, 800.0},        Method -> {"EventLocator",          "Event" ->           Boole[Abs[             Sin[y[140][t] - y[141][t]]/norm - 1] >             1/10], "EventAction" -> Print["t:", t]},        WorkingPrecision -> 30, AccuracyGoal -> 15, PrecisionGoal -> 15,        MaxSteps -> Infinity]      All the constant have a value well ascertained value, including norm that is a normalization responsable for the deviation detect. The answer to this, in mathematica 7, is:               NDSolve::precw: The precision of the differential equation ({((y[0])^\[Prime])[t]==1,((y[141])^\[Prime])[t]==1,((y[1])^\[Prime])[t]==1/2+66.439 (Sin[Subscript[\[Null], <<2>>][<<1>>]+Times[<<2>>]]-Sin[Plus[<<2>>]]),<<6>>,((y[8])^\[Prime])[t]==1/2+66.439 (Sin[\[Null], <<2>>][<<1>>]+Times[<<2>>]]-Sin[Plus[<<2>>]]),<<274>>}) is less than WorkingPrecision (30.`). >>          NDSolve::evre: The value of the event function at t = 2.79284074034703538067228005241`30.*^-10 was not a real number.  The event will be ignored in steps where it does not evaluate to real numbers at both ends. >>      Please note that this logic is set to work, i.e. this error is not dependent in the value of norm in the sense that it needs it to detect the deviation. The point is: why Mathematica is outputing an error saying that something is not a real number ? where is the thing that is not a real number ? Iam sorry if the example is too extense, i think that the problem poses it in this form or iam too newbie in mathematica and dont know rewrite. Does anyone has any suggestion in order to circumvent it ? Thank you !!!


Colours in BarChart[]

This question is a follow up from this one. I want to be able to specify a list of colours for my bars in `BarChart`. In responses to the question I linked to, @kguler produced the following, which sets the bars to the left of x=8 as a different colour:               cedF[{{xmin_, xmax_}, {ymin_, ymax_}}, ___] :={If[xmax <= 8,         RGBColor[1, 0, 0], Sequence[]],       Dynamic@EdgeForm[Directive[Thickness[.015], Lighter@CurrentValue["Color"]]],      Rectangle[{xmin, ymin}, {xmax, ymax}, RoundingRadius -> 5]};          Histogram[RandomVariate[NormalDistribution[10, 2], 500],ChartStyle -> "Pastel",        ChartElementFunction -> cedF]      ![kguler example](http://i.stack.imgur.com/lHIGV.png) My question is how to generalise this: I would like to be able to have a list that specifies the colours of every bin uniquely. How would I go about this? If[] statements seem a bit clunky for this application.


How do I create a histogram with unequal bin widths?

I would like to create a histogram for human population by age, but the $2010$ census data I have available is for five uneven cohorts: ages $0$-$17$, $18$-$24$, $25$-$44$, $45$-$64$, and $65+$. My county has the following data: `{86031, 26671, 91927, 93983, 32232}`, for a total population of $330844$. The corresponding histogram bins should have widths `{17, 7, 20, 20, 20}` and heights `{86031/17, 26671/7, 91927/20, 93983/20, 32232/20}`. I will eventually want to make this pretty by adding labels, etc., but I don't see how to even get started.


Is the System Information that Mathematica displays not completely correct?

Or maybe I did not understand the meaning of Resolution. This is the code I used -               SystemInformation["Devices", "ScreenInformation"]      I get 120 as my system resolution, and Full Screen Area as 1366x768 (~14" diagonal screen). I checked with two of my colleagues who have mathematica installed. The one with a ~15.4" diagonal screen got Resolution as 96 & Full Screen Area as 1366x768. This made sense, sort of, a bigger screen is lesser dense pixel-wise for the same pixel screen area. But when I checked with another ~14" diagonal screen laptop, mathematica returned Resolution as 96 & Full Screen Area as 1366x768. This doesn't make sense, two physically equivalent screens with same pixel area but different resolutions. So I cross-checked in these two websites - http://pediddle.net/dpi-ruler.html and http://concentriclivers.com/screen_density.html Both my laptop and the other 14" laptop got similar dpi's of 112, and the 15" laptop returned a dpi value of about 100. I did the math and these numbers fit it just well. So is Mathematica wrong here? Or am I barking up the wrong tree for the dpi value? I am new here, so thanks for any help extended, in advance!


Solving differential equations with sums (power series)

I have sets of 10 differential equations, but for this purpose I'll demonstrate what I need on one example that can be solved by hand. My equation is this: $$4GJ\Omega(\theta)\Omega'(\theta)\xi^\theta(\tau,r,\theta,\varphi)+4GJ\Omega^2(\theta)\frac{\partial \xi^\theta}{\partial\theta}=\mathcal{O}(r^{-1})$$ I need to assume that the solution of $\xi^\theta$ is in the form $$\xi^\theta=\sum\limits_n\xi_n^\theta(\tau,\theta,\varphi)r^n$$ and it truncates for large n, where n is negative. If I put that in my equation, and say that all powers greater or equal of 0 will be zero, I get $$\Omega'\xi^\theta_n+\Omega \xi_{n,\theta}^\theta=0,\quad for\ n\geq0$$ where $\xi_{n,\theta}^\theta=\frac{\partial \xi_n^\theta}{\partial\theta}$ for shorthand notation simplification. Now, this basically means that my general solution for $\xi^\theta$ is $$\xi^\theta=\xi^\theta_{-1}r^{-1}+\mathcal{O}(r^{-2})$$ which is what I need to get. Now, my question is: is it possible to do this for all other equations in Mathematica. I got my equations, and I made substitution:               ξθ=Sum[ξ[τ, θ, φ][m]*r^m, m]      and got the result               4 G J Ω[θ]((Sum[D[ξ[τ, θ, φ][m],θ]*r^m, m])Ω[θ]+(Sum[ξ[τ, θ, φ][m]*r^m, m])Ω'[θ])      As I should. Is it possible now, to somehow get the most general result, like I got by solving by hand? I'm asking because I have 10 equations like this, and some have other terms ($\xi^r,\xi^\tau,\xi^\varphi$) that I need to find the general solution to. Do I actually expand it to some order and somehow truncate higher terms? EDIT: The power series solution is in the negative expansion.


Attaching a file to a notebook

Is there a way to attach a file into a notebook and open it later with, for instance, a double click (or another action button)? In Mathematica windows version, the insert menu has the "object..." entry and I can indeed embed an object into my notebook. But then, I don't know how to exploit it in an attachment kind of way. For instance, in MS Word, if we "insert an object", we can then open it by double clicking its icon: windows opens the file with its predefined application. For the purpose of the discussion, let’s suppose I want to attach a pdf file. If this functionality isn't native on Mathematica, probably a technique based on this post can be used, with an intermediate step of export to a temporary folder, and then a `Run` kind of command... I can also imagine a `Dynamic` interface, with a list of attached files (whose internal data/content is “kept” by a `DynamicModule` internal variable), and four buttons: add, delete, export and open. Since a `Dynamic` cell can be easily copied from a notebook to another, I could easily use this small embedding app on different notebooks. There’s probably another button that would be useful: import. This would make the file content available, as a string, on a global context variable, or at least export the file to a temporary folder, and make its path available on a global context variable. (if you go the "dynamic app" way, please consider, from the beginning, app conflicts if two apps are added to the same notebook; and a more tricky, or probably impossible task, to make some of its functionality work on the Player) **EDIT - 2014-01-12** **(there was an error with the OPEN, that has now been corrected)** Current version: ![enter image description here](http://i.stack.imgur.com/PP3Rv.png) Code and example file: download here Any help on making it better is appreciated, specially in the domain of the compression ratio and safety (currently using GZIP). Future developments (if anyone can help):   * attach the notebook itself without passing through files (poor man self-included versioning)   * attach a Save of a specific variable/definition or a list of them, without passing through files.   * attach a Save of the entire session, to record current state of sessions (kind of persistent memory)   * load stored Saves (with the option of overlaying the existing memory, substitute completely the existing memory (clearing other definitions), adding definitions with an indexed definition name or or an indexed context, so to allow comparisons...)   * export recorded files to variables, so to work on them (ImportString, etc) without passing through files   * and any other crazy infeasible idea... **EDIT - 2014-02-09** It is now possible to save the definitions of the current context. It is very rough, and I would greatly appreciate some help to improve it. Things that are not great:   * it stores its own definition, which could probably be avoidable   * something better should be thought for the problem of creating a new context registry when an old one is opened   * why only the current context, and not a checkbox tree list where one checks contexts and/or definitions that would like to be stored   * no warning for very large content being saved The file can be downloaded here ![enter image description here](http://i.stack.imgur.com/5yLw0.png)


“automated” image embedding app

Based on the following image attach procedure, can a `Dynamic` app be developed that:   1. at start, only shows a small import button   2. once clicked, opens a choose image file dialog   3. after the image file chosen by the user, asks for representation dimension (pixels or percentage of the screen, etc), some other stuff possible: type and degree of compression (native, JPG, etc), frame, tear down effect etc   4. after options chosen, removes the button and replaces it with the low footprint image following the chosen options   5. right click on the image, and we can choose two "empty" the space (to restart the process) Actually, there should be two import buttons: one for a file dialog, and another for importing from the clipboard (very useful when used with a screen snag tool). An output cell with this dynamic app could then be easily duplicated and past to different notebooks, in order to facilitate the procedure of the above referenced post.


Provided an array of 2D point clouds, can we quickly replace distance- and index-based cliques of points with their median or mean values?

Imagine I have $N \approx 10^5$ clouds of points in an array of the form: UPDATED               numClouds = 10^3;     cloudList = Table[Table[{RandomInteger[{0, 2}] + RandomReal[{-0.1, 0.1}], RandomInteger[{0, 2}] + RandomReal[{-0.1, 0.1}]}, {j, 1, RandomInteger[{0, 50}]}], {i, 1, numClouds}];      Notice that we generate points here by first randomly snapping them to a coordinate in an integer lattice, and then adding some real number valued noise:               ListPlot[Flatten[cloudList,1]]      I'd like to move a sliding window over `cloudList` of size $k$ (e.g. $k = 10$) where we take all of the points in `{cloudList[[i]], cloudList[[i+1]], ..., cloudList[[i+k]]}`, establish cliques for points within a Euclidean distance $d$ of one-another (i.e. if we can place a circle of diameter $d$ over a set of points, it's a clique), and then replace all of the points within each clique with the median or mean point value of the given clique. I would like to do this without disturbing the array structure of `cloudList`. In terms of finding a fast way to grab all the points within a critical radius of $\frac{d}{2}$, we can use a poorly documented version of `Nearest`: > `Nearest[data, x, {n, r}]`   >  give up to the `n` nearest elements to `x` within a radius `r` The above was from an answer by the user "ssch" (http://mathematica.stackexchange.com/users/1517/ssch) to my question: Selecting for 2D points that are within a threshold distance of an upper- and lower-bound number of points * * * Update - I neglected to specify what should occur when points can belong to more than one clique. The user belisarius (http://mathematica.stackexchange.com/users/193/belisarius), for example, asked about the cliques for a point set `Tuples[{1, 0}, 2]` where `r = 3/2`. Here, all four points belong to the same clique:               list = Tuples[{1, 0}, 2];     nf = Nearest[list];     nf[list[[1]], {Infinity, N[3/2]}]          out :: {{1, 1}, {1, 0}, {0, 1}, {0, 0}}      So we'd set each point in this clique to `{1/2,1/2}`. However, if we set `r = 1`, we have `Binomial[4, 3] = 4` seperate cliques with overlapping points:               {{1, 1}, {1, 0}, {0, 1}}     {{1, 0}, {1, 1}, {0, 0}}     {{0, 1}, {1, 1}, {0, 0}}     {{0, 0}, {1, 0}, {0, 1}}      To resolve this, I'd like to generate each clique as above, compute a mean for each clique, and where points fall in multiple cliques, to randomly assign these points the mean or median value selected with uniform probability from each clique. However, I'd be open to simpler solutions that are easier to implement. * * * (2nd) Update - I have changed the method of generating the random test set s.t. we now first snap a randomly generated test point to a bounded integer lattice coordinate, then add noise. * * * (3rd) Update - This is more of a note, but I would be fine employing a simple greedy algorithm to partition points into clusters, or using `FindClusters` with a `EuclideanDistance` distance function (this is slightly less comfortable since I'm not exactly sure what the underlying algorithm is).


How do I remove the subscript after calling BaseForm[]?

Say I want to convert some number $N$ to base $k$. Here, I might use the command `BaseForm[N,`k]`, e.g.,`BaseForm[10,`2]` which gives the output 1010[2] (where [2] is subscript). How can I drop the subscript and manipulate the number as if it is a normal integer in decimal form? I'd ideally like to do this without any string processing?


Extracting a single layer from a SHP file

I have an ESRI ShapeFile (SHP) that I've loaded. It has a number of layers which I can see the names of by using:               Import["file.shp", "LayerNames"]      I get something like > {"Africover_Kenya_Spatial_Aggregation", "ke-landcover", "ke-forests", \ "ke- > rangeland", "ke-agriculture", "ke-waterbodies", "ke-bareareas", \ "ke- > urban", "ke-politicalboundary", "theme1"} I would like to import just one layer ("ke-landcover" for example) from the data but I can't figure this out. If I ask for the "Graphics" element, I think I get the layers individually, but I don't know how to verify whether this is true or not. I'm new to mathematica, and documentation for GIS applications is limited at best. Can anyone help me? Thanks!


Maximizing Large Multivariable Function over Region with Parameter Constraints

Brand new Mathematica user here. I have a complicated function to maximize, and thought I would try software like Mathematica instead of taking derivatives by hand. I found some Mathematica documentation and believe I've entered the code correctly. Here is my entire code:               Maximize[{(1/2)*(1/(1+2*y-y^2-x^2-2*x^2*y+2*x*y^2))*(a-c*(y^2/(-2*x^2*y^2+2*x*y^2-y^2+2*y+1)+((1+2*y-2*y^2-x^2-2*x^2*y+2*x*y^2)/y^2)*(1-1/(-2*x^2*y^2+2*x*y^2-y^2+2*y+1)))), 0<=x<=1, 0<=y<=1, 0<c<a}, {x,y}]      I believe my syntax is correct, however I'm in doubt over whether I've put my constraints in the right place. The variables $x$ and $y$ are the probabilities with which I want to maximize my function, so I "constrained" them between $0$ and $1$. And the parameters $a$ and $c$ are such that $c>0$, and $a>c$ (these are not variables -- I only want to maximize over the probabilities). Running the script causes Mathematica to say "Running..." and never give a result. Does Mathematica have a limit on how complicated a function can be? Thanks!


Mapping points on the unit circle

I have a set of points P that are evenly spaced on a square grid of length 1... I would like to map these points to the circle of radius 1 as nicely as possible, while preserving relative positions as much as possible. That is, the points in the square grid should map to the points in the unit circle. How can this be done in Mathematica?


Find names similar to a given name in a large data set

I'm trying to find a 'similar' name to every item in a list                nearName[name_, namesList_] :=         Module[{lista, pos},          lista = EditDistance[ToLowerCase[name], ToLowerCase[ToString[#]]] & /@ (namesList);          pos = Flatten[Position[lista, Min[lista]]];          If[Length[pos] > 1 || Min[lista] > 3 , Missing["NotAvailable"], namesList[[pos]]]]      The problem is that with a very large input (`nameList` contains about 400k items and I make about 1k calls to `nearName`), `nearName` is using a lot of CPU. Is there any way I can make this faster?


How to create a spliced survival statistical distribution?

I am trying to use Mathematica for more of my reliability engineering work and am having trouble using SplicedDistribution. I have a Weibull distribution (dist1) associated with a low stress condition, β1 = 2.59 and η1 = 25889. I have a different Weibull distribution (dist2) associated with a high stress condition with the characteristic life being 1/3 that for dist1, β2 = 2.59 and η2 = 8630. The need is to create a spliced distribution such that for the first 5000 hours only dist1 applies and thereafter only dist2 applies. Think of a device that operates in a relatively clean, stress-free environment for the first 5000 hours of its life, then it is abruptly placed in a stressful, corrosive atmosphere thereafter. My attempt in using SplicedDistribution does not seem to work as shown in the comparison plot below. SplicedDistribution appears to be “mixing” the two distributions for all time, t as opposed to letting only dist1 govern for the first 5000 hours then allowing only dist2 to govern thereafter. I would expect that dist3 would be equivalent to dist1 for the first 5000 hours then its survival (reliability) curve would depart from dist1. Can someone show me how to accomplish what I need using Mathematica ? ![enter image description here](http://i.stack.imgur.com/BvJRy.png) Here is my version 9 code:               {β1 = 2.59, η1 = 25889.};     dist1 = WeibullDistribution[β1, η1]     plot1 = Plot[SurvivalFunction[dist1][t], {t, 0, 18000},        PlotStyle -> Black, Frame -> True,        FrameLabel -> {"Time (hours)", "Reliabilty,  R[t]"},        PlotRange -> {0, 1.05},        PlotLabel -> "Distribution 1 Reliability Plot"]          {β2 = 2.59, η2 = 8630.};     dist2 = WeibullDistribution[β2, η2]     plot2 = Plot[SurvivalFunction[dist2][t], {t, 0, 18000},        PlotStyle -> Blue, Frame -> True,        FrameLabel -> {"Time (hours)", "Reliabilty,  R[t]"},        PlotRange -> {0, 1.05},        PlotLabel -> "Distribution 2 Reliability Plot"]          plot3 = Show[plot1, plot2, PlotRange -> All,        PlotLabel -> "Distribution 1 & 2 Comparison Plot"]          dist3 = SplicedDistribution[{1, 1}, {0, 5000, ∞}, {dist1, dist2}]     plot4 = Plot[SurvivalFunction[dist3][t], {t, 0, 18000},        PlotStyle -> Red, Frame -> True,        FrameLabel -> {"Time (hours)", "Reliabilty,  R[t]"},        PlotLabel -> "Distribution 3 (Spliced) Reliability Plot"]          plot5 = Show[plot3, plot4, PlotRange -> All, AxesOrigin -> {0, 0},        PlotLabel -> "Comparison Plot",        Epilog -> {Text["Distribution 1 (low stress)", {15000, .9}],         Text["Distribution 2 (high stress)", {10500, .6}],         Text["Distribution 3 (spliced)", {6000, .2}]}]


Downvalues vs. Scoping for Functions

Regarding my recent question on using a default value for a function argument when a pattern was not met yielded some interesting answers, but the general consensus was "Yes this can be done, but there are better options." Assuming the same conditions that certain function arguments (`rt` and `pt` in this case) should default to zero when less than zero, the three main options are as follows: **Downvalues:**               func[qi_, dei_, b_, dmin_, rt_, pt_, t_] :=           func[{qi, dei, b, dmin, Max[0, rt], Max[0, pt], t}]          func[{qi_, dei_, b_, dmin_, rt_, pt_, t_}] := (*do stuff*)      _Or..._               func[qi_, dei_, b_, dmin_, rt_?Negative, pt_, t_] := func[qi, dei, b, dmin, 0, pt, t]     func[qi_, dei_, b_, dmin_, rt_, pt_?Negative, t_] := func[qi, dei, b, dmin, rt, 0, t]          func[qi_, dei_, b_, dmin_, rt_, pt_, t_] :=(*do stuff*)      **Scoping:**               func[qi_, dei_, b_, dmin_, rt_, pt_, t_] := Module[{rtt = Max[0,rt], ptt = Max[0,pt]},        (*do stuff with rtt and ptt instead*) ]      What are the pros and cons of each function definition? Which is the most efficient?


How can this type of optical illusion be created in Mathematica?

I see these around the web and would like to make them in Mathematica.   Combining them in an array is actually quite mesmerizing! ![Moving Illusion](http://i.stack.imgur.com/zHC6P.jpg)


large matrix eigenvalue problem

I need solve a very large complex matrix (not sparse and not symmetry) eigenvalue problem, e.g., 1e4*1e4 or even 1e6*1e6. How large dimensions of the matrix can Mathematica support? And, how about the run time? Or, any one have good suggestions for this?


Vectors with a certain magnitude in Mathematica

For a user specified magnitude, is there a way to have Mathematica produce any 3D vector that fits that magnitude?


Solving a system of equations with variable coefficients

I am trying to solve a system of equation which seems to be simple but much as I tried I couldn't solve it in _Mathematica_ and it says the coefficients need to be exact. Now, I was wondering if someone walk me through the step by step procedure of solving such equations. I have a variable, `phi`, which is a function of `P`. `P` is a real number and `0 < P < 1`.               phi = 45 beta^P;       where `beta` is a constant. Now the system of equations:               x^(-1/2) y^(-P) - x^(-1/2) y^P phi^2 = 3 phi     2 x y^(-P) - x y^(1 - P) = 4/phi


How do I use a while-loop to find the gain of a transfer function's limit?

At the moment I can find the limit of my transfer function as follows:               (5 4001.6`)/(5 4001.6` + (4 + s) (200 + s)) /. s -> 0      This works as I would expect and provides a final value of 0.961553 In this example my value of gain, k, is 4001.6` so re-writing the expression for arbitrary k would give:                  (5 k)/(5k + (4 + s) (200 + s)) /. s -> 0      I want to find a value of k that makes the result 0.95. To do this I was thinking about using a while loop. I thought the while loop could start with k=1, compute the limit, test to see if less than 0.95, and if not increment k by one, and perform the test again, until the correct value of k is found: This is what I have tried:                   k = 1; While[(5 k)/(5 k + (4 + s) (200 + s)) /. s < 0.95, k++]      However I get the error: "ReplaceAll::reps: {s<=0.95} is neither a list of replacement rules nor a valid dispatch table, and so cannot be used for replacing. >>" Any help would be most appreciated.


compile function and floating points

The compile function I have written computes a table of relative frequencies of some data. Thus, the output is a list of increase elements, p, in [0,1]. Since I have say 1000 data points the elements p are equal to x/1000 and x in [0,1000]. Hence, each p should have a maximum of three positions after the decimal point. However, if I run the compile function then values having many more positions after the decimal point appear. However, this appears to be true not for all elements of the resulting list. For example, let the true p equal 0.894, then the compile output reads p = 0.8949999999999. How can I force the result to be 0.894? Unfortunately, `Round[p,1./1000.]`does not work within the compile function. It does not work either if I apply `Round`to the resulting `list`. What works, but seem inefficient, is `Round[list,1/1000]//N`. Thanks for help.


Understanding "IntensityData" coordinates

Update - Playing around a bit, is it true that we need to process the list of "IntensityData" values $r$ as follows:               r = Partition[r,k];     r = Transpose@r;      And then apply:               vmapped= c + {v[[1]] - k/2 - 0.5, k/2 - v[[2]] + 0.5}      It looks like this properly maps the point $v$ to the larger image containing the morphological component with "IntensityData" $r$, however, it's difficult to tell if there's a small error here? ** I would like to ask a follow-up to a previous question - Understanding the computation of IntensityCentroid? \- since this question was answered well, but I am still a bit confused about the coordinates for "IntensityData". Let $m$ be a square morphological component with $k \times k$ pixels. Let $c$ be the output of `ComponentMeasurements[{m,img},"Centroid"]`, let $r$ be the output of `ComponentMeasurements[{m,img},"IntensityData"]`. For an example, we can set:               k = 7;     c = {157.5, 92.5};     r = {0.509752, 0.958211, 0.177492, 0.679586, 0.651634, 0.159438, 0.249294,                0.840233, 0.403427, 0.706836, 0.0924188, 0.523653, 0.907517, 0.219175,           0.134596, 0.599349, 0.320155, 0.417359, 0.767355, 0.280942, 0.960531,           0.332421, 0.756754, 0.186532, 0.188323, 0.457144, 0.80254, 0.252036, 0.66885,           0.0437862, 0.674661, 0.125856, 0.134035, 0.62525, 0.328863, 0.84693,           0.644811, 0.877901, 0.0685183, 0.307649, 0.481993, 0.695101};      We then partition $r$ in the following way to structure the data in the form of ImageData:               r = Partition[r,k];      I then do "something" to calculate a coordinate with respect to the coordinate frame in `Image[r]`. Call this coordinate $v$, where we might have, for example, `v = {4.232,7.827}` (perhaps this is an intensity centroid in the the coordinate system for $r$). Using image coordinates rather than indices, i.e. the coordinate system used when outputting a value for `ComponentMeasurements[{m,img},"IntensityCentroid"]`, how can I use only the component centroid $c$ to map $v$ to my original image, `img`? Note that I only provide you with $k$, $c$, and $v$ for this mapping, not the original image. Ok, let's provide a small example using ten morphological components. Here, the first set of coordinates in each three-element array represents $v$, which is something similar to an intensity centroid computed with the output of `r = Partition[r,7];` where $r$ is the `"IntensityData"` output for some box-like morphological component with a 7-pixel edge-length. The second set of coordinates in each array ({72.5,250.5}, {208.5,246.5}, etc.) represents the output of `ComponentMeasurements[{m,img},"Centroid"]` for the morphological component used to grab $r$. The final set of coordinates is the output of `ComponentMeasurements[{m,img},"IntensityCentroid"]` for the particular morphological component.               componentOneArray={{4.1209,2.39237},{72.5,250.5},{73.1307,250.376}}     componentTwoArray={{4.10345,2.51433},{208.5,246.5},{208.993,246.415}}     componentThreeArray={{2.74777,11.3037},{18.5,229.5},{16.6019,229.926}}     componentFourArray={{3.75292,2.4059},{92.5,228.5},{93.1028,228.757}}     componentFiveArray={{3.74452,3.1833},{109.5,224.5},{109.302,224.697}}     componentSixArray={{3.76436,2.40024},{137.5,223.5},{138.098,223.743}}     componentSevenArray={{3.52801,2.6132},{221.5,221.5},{221.89,221.992}}     componentEightArray={{4.10626,2.43366},{64.5,209.5},{65.0603,209.391}}     componentNineArray={{4.08676,3.06379},{98.5,208.5},{98.4326,208.419}}     componentTenArray={{3.90224,3.10008},{30.5,205.5},{30.3848,205.606}}      How can we use use the second element of each list, $c$, to map the first element of each list, $v$, to the coordinate system used for the computed intensity centroid of the morphological component?


Hide both input cell and output cell

You can double-click the right gutter of a input cell to hide a corresponding output cell or double-click the gutter of the output cell to hide the input cell. I would like to hide both the input and the output cell. Is this possible to do within the GUI?


Calculate proportion of values for dates

At work, we were discussing when is it the best time to change to winter tires for bikes and/or cars. Using `WeatherData[]` and `DateListPlot[]`, it was fairly straightforward for me to create the diagram below: ![Mean temperature per day in Stockholm](http://i.stack.imgur.com/Y5wNT.png) _Fig 1 Mean temperature per day in Stockholm, red is negative and a risk without winter tires._ The code for this is               cityTemp = WeatherData["Stockholm", "MeanTemperature", {{1977, 1, 1}, {2011, 12, 31}, "Day"}];     iceRiskDays = Select[cityTemp, Last[#] < 0 &];          yearStrip[ dataItem_] := {{0, Part[First[dataItem], 2], Last[First[dataItem]]}, Last[dataItem]}          DateListPlot[{yearStrip[#] & /@ cityTemp, yearStrip[#] & /@ iceRiskDays} ]      My question is: **How do I calculate for each day the proportion of values for that day that are below 0 Celsius?** (e.g. for a date at the end of November, the proportion is likely to be bigger than 0.5)? My attempts to do this ended with trying to create separate lists for each date, but I felt that this was a less elegant way and also creates less "fit" with DateListPlot.


How to normalize parts of matrix elements?

To normalize the last 2 or more columns of a matrix,               m = {{0, 0, 135, 276}, {0, 1, 762, 852}, {0, 2, 762, 852}, {1, 0, 162,     852}, {1, 1, 362, 852}, {1, 2, 262, 852}}      I can do that by               mm = Transpose@      m /. {m[[All, 3]] -> m[[All, 3]]/(m[[All, 3]] + m[[All, 4]]),       m[[All, 4]] -> m[[All, 4]]/(m[[All, 3]] + m[[All, 4]])} // Transpose // MatrixForm      Or step by step               mt = Transpose[ m]          msum=mt[[3]]+mt[[4]]          m3=mt[[3]]/msum          m4=mt[[4]]/msum          mlast = Transpose[mt /. {mt[[3]] -> m3, mt[[4]] -> m4}]      are there any more elegant method in Mathematica?


Apply rule only if applicable? Check rule applicability? Custom unapplicable rule?

How to avoid recursion in the following example?               Clear[MyRule];     Clear[MyHead1];          MyRule1 = MyHead1[x_MyHead2] | MyHead1[x_MyHead3] -> x;          MyHead1[x_] := Replace[MyHead1[x], MyRule1];          MyHead1[a]          MyHead1[MyHead2[b]]      How to make first rule in example below treated by `Replace` as not applicable?               In[17]:= ComplexRule1 = a -> Block[{},         12         ];          In[18]:= ComplexRule2 = a -> Block[{},         13         ];          In[19]:= Replace[a, {ComplexRule1, ComplexRule2}]          Out[19]= 12


How to write a MathLink function in C that returns nothing

What is the proper way to write a C MathLink function that returns nothing at all? The following works, but I'm not sure if all this work is actually necessary: The template file:               :Begin:     :Function:      fun     :Pattern:       fun[]     :Arguments:     {}     :ArgumentTypes: {}     :ReturnType:    Manual     :End:      The C code:               void fun() {         MLPutSymbol(stdlink, "Null");     }      In short, here I set the return type to `Manual` and explicitly returned `Null`. Is this all necessary or is there a shorter way?


Why does the mean in my coin tossing simulation not approach 1/2?

I simulate a simple experiment, a coin flip. What I do is accumulate the mean of the results up to the i-th experiment. What I can't figure out is why the computed means do not asymptotically approach 1/2. What did I do wrong? The code:               n = 10^4;     c = Table[{i, RandomInteger[]}, {i, 1, n}];     s = 0;     m = {};     For[i = 1, i <= n, i++,       s += c[[i, 2]];       AppendTo[m, {i, N[s/i]}];     ]


Convert boolean test function to pattern?

What is a "reverse" to `MatchQ`? `MatchQ` converts pattern into boolean function. So how to convert back? Suppose I want to use boolean function in `Switch`.


Vlookup function as Excel in Mathematica

How can we create a Vlookup function, similar to what we have in Excel? So if we have a table `a` and another `b`, we could add columns to table `a`, based on a common key to both, in order to create a table `c`. ![Tables](http://i.stack.imgur.com/89Bad.png)


Custom attributes?

Is it possible to assign custom attributes to symbols and check them later?               SetAttributes[a, b]      says               Attributes::attnf: b is not a known attribute.


How do I overlay a histogram with a plot of CDF?

data = Flatten[Import["speedtest1B.csv"]];     distrib = HistogramDistribution[data];     histogram = Histogram[data, ChartStyle -> {Blue}];     Export["speedtest1B.pdf",          Overlay[{          Histogram[             data,              ChartStyle -> {Blue},             ImageSize -> {500,500},             AxesLabel -> {"start-up time [ms]", "number of samples"}             ],         DiscretePlot[             CDF[distrib, x],              {x, 0, Max[data]},             ImageSize -> {500,500},             Axes -> False             ]             }         ]     ];      From the above I get: ![enter image description here](http://i.stack.imgur.com/G4mqh.png) I would like the plots to be properly aligned. Displaying the CDF x-axis on the right side of the plot would be a big plus. Also I don't realy get color- theaming so could someone please explain how to easily change the color od CDF to red.


Upsampling matrix by inserting zeros inbetween elements

I want to essentially take an image with $n \times n$ pixels and expand it into a sparse array, spacing out the pixels by a factor $2$ or $3$. Each pixel in the input image occupies one of the corners of a cell of $2 \times 2$ or $3 \times 3$ new pixels in the expanded image, with the other $n \times (n - 1)$ pixels (in each cell) set to $0$. So, I want to create a padded array where: If one line of data is               WXYZ      then the output should be               W0 X0 Y0 Z0       00 00 00 00      I think _Mathematica_ 's `SparseArray` might be the way to go, but I'm not sure how to go about implementing this.


Export list elements each to it's own page in a multi-paged PDF document

I have a list, `myList`, of let's say 20 (different) objects               myList = Table["object", {20}]      I know would like to export every single element of `myList` to its own PDF page in a 20-paged PDF document; i.e., `myList[[1]]` comes on page 1, ..., myList[[20]] comes on page 20. Is this possible in _Mathematica_? I have heard of the `Export` function, of course, but have not seen any way of combining 20 exports in one single document.


How to constrain the generation of all possible orderings?

Here is code from Simon Woods' answer for getting all possible weak (equal ranks allowed) orderings for $N=3$ objects:                ClearAll[f]; SetAttributes[f, Orderless];      ReplaceList[f[a, b, c], f[a___, b___, c___] :> {{a}, {b}, {c}}] //      DeleteCases[#, {}, -1] & // Union // Column      It gives $13$ such orderings:               {{a, b, c}}     {{a}, {b, c}}     {{b}, {a, c}}     {{c}, {a, b}}     {{a, b}, {c}}     {{a, c}, {b}}     {{b, c}, {a}}     {{a}, {b}, {c}}     {{a}, {c}, {b}}     {{b}, {a}, {c}}     {{b}, {c}, {a}}     {{c}, {a}, {b}}     {{c}, {b}, {a}}      How can I modify this code for the case when not more than $2$ subsets are allowed? The desired output is:               {{a, b, c}}     {{a}, {b, c}}     {{b}, {a, c}}     {{c}, {a, b}}     {{a, b}, {c}}     {{a, c}, {b}}     {{b, c}, {a}}      I am trying to find way for doing such reductions in general $N$ and for any number of subsets-restriction.


Setting OperatorSubstitution to false causes Plot's labels of sufficiently small size not to appear in the specified typeface. Is this a bug?

If I set `OperatorSubstitution` to `False`, the labels of `Plot` will not use the typeface specified by `FontFamily` unless `FontSize` is more than certain number. In this test scenario, that certain number is `14` and the typeface is `Ubuntu` (Regular) (TTF fonts available from font.ubuntu.com).               SetOptions[Plot, AspectRatio -> 1, ImageSize -> {200, 200}];      Row[{       Plot[x, {x, 0, 1},          LabelStyle -> {FontFamily -> "Ubuntu", FontSize -> 14},          BaseStyle -> {PrivateFontOptions -> {"OperatorSubstitution" -> True}}],        Plot[x, {x, 0, 1},          LabelStyle -> {FontFamily -> "Ubuntu", FontSize -> 14},          BaseStyle -> {PrivateFontOptions -> {"OperatorSubstitution" -> False}}],        Plot[x, {x, 0, 1},          LabelStyle -> {FontFamily -> "Ubuntu", FontSize -> 15},          BaseStyle -> {PrivateFontOptions -> {"OperatorSubstitution" -> False}}]     }]      ![15 is the threshold.](http://i.stack.imgur.com/w4rMJ.png) Only some typefaces are affected (eg Inconsolata is fine). Is this a bug? I'm using Mathematica 9 for Mac.