Numbering nested list according with Depth (or Level)

(This question is slightly similar with _Sequentially numbering a nested list_, but not exactly the same.) # What I want Say I have a nested list               lst = {{"X", {{"X", "X"}, {{"X", "X"}, "X"}, "X"}, "X"}, "X", "X"};      What I would like to do is to label each `"X"` with a number according with its `Depth`/`Level`, that is something like this               {{{2,"X"},{{{4,"X"},{4,"X"}},{{{5,"X"},{5,"X"}},{4,"X"}},{3,"X"}},{2,"X"}},{1,"X"},{1,"X"}}      # What I tried I used a dumb way to achieve my goal. First I label each `"X"` with a unique label:               labelLst = lst /. "X" :> RandomReal[]      Then get their positions:               posSet = Position[labelLst, #][[1]] & /@ Flatten[labelLst]      Then label `"X"`s with its `Depth`:               ReplacePart[lst, Function[pos, pos -> {          Length[pos], lst[[##]] & @@ pos          }] /@ posSet]      # My question I think taking the aid of extra real-number labels is a bit cheating and inelegant, so I want to ask for a more elegant method for this. By saying _elegant_ , I'm thinking of something pure list-manipulations. Any idea would be helpful. * * * **Why I need this:** I'm trying to format the result of `Trace` for external plain-text viewer. Label numbers according with `Level`s eventually lead to human friendly indents.               Clear[levelIndentFunc]     levelIndentFunc[lst_] :=      Module[{labelLst, posSet},       labelLst = lst /. e_HoldForm :> RandomReal[];       posSet = Position[labelLst, #][[1]] & /@ Flatten[labelLst];       ReplacePart[lst, Function[pos, pos -> StringJoin[Flatten@{                 ConstantArray["\t", Length[pos] - 1],                 StringTake[                  ToString[lst[[##]] & @@ pos, InputForm], {10, -2}]                 }]] /@ posSet] // Flatten // Riffle[#, "\n"] & // StringJoin       ]      Example:               traceRes = Trace[Reduce[x^2 == -1, x], TraceInternal -> True, TraceDepth -> 3];     Export["tracePrintTest.txt", levelIndentFunc@traceRes, "String"]      Open _tracePrintTest.txt_ in external text viewer (here _Sublime Text_ with Mathematica syntax highlight plugin): ![traceprint](http://i.stack.imgur.com/z0lBh.png) **Edit:** With the help of Mr.Wizard's `MapIndexed` function, the formatting function `levelIndentFunc` can be simplified to               Clear[levelIndentFunc]     levelIndentFunc[lst_] :=      MapIndexed[         {ConstantArray["\t", Length[#2] - 1], #1, "\n"} &,         lst /. e_HoldForm :> StringTake[ToString[e, InputForm], {10, -2}],         {-1}] // Flatten // StringJoin


Finding real roots for an eigth-degree polynomial

The context for this problem is identical to my first question. Unfortunately my previous result for $L$ was inexact since it was a relatively simple approximation. This time I have managed to produce a very convincing approximation for $L$. Alike last time, solving for $W$ provides the $n$th solution if you find the $n$th root of a specific [octive] polynomial: $96x^8-192Lx^7+(768π^2 A^2+128L^2 ) x^6+(-64L^3-640A^2 π^2 L) x^5+(2655π^4 A^4-640L^2 π^2 A^2+32L^4 ) x^4+(384A^2 L^3 π^2-578A^4 Lπ^4 ) x^3+(4476π^6 A^6-2760L^2 π^4 A^4+128L^4 π^2 A^2 ) x^2+(456A^6 Lπ^6-278A^4 L^3 π^4 )x+(3136π^8 A^8-3700L^2 π^6 A^6+1089L^4 π^4 A^4 )=0$ Since my investigation is based on the assumption that there is only one value for $W$, given the values of $A$ and $L$, ergo there should only be two real roots (one should be the positive value for $W$ and the other should be the negative value for $W$.) My question is, can you find the positive real root for the eight order polynomial above?


About how Mathematica understands the branchcuts of the complex logarithm [Part 3]

One understands that for the function $\log(z^2+a^2)$ Mathematica implicitly puts the branch cuts to be starting at $\pm ia$ and going up/down respectively on the imaginary axis. The phase of this function approaches $i\pi$ on the right and above $ia$ and it approaches $-i\pi$ on the right and below $-ia$. Now I put in the following sequence of commands,               a = 2; y = 0.0000000001; d = y ;      z = I a + I y + d - I t;          Plot[ Im [ Log[z^2 + a^2] ], {t, 0, 5}]      I am trying to track the imaginary part of the function, `Log[z^2 +a^2]` as $z$ moves along a straight line parallel to and very close to the branch cuts of this function starting at $z=ia +iy + d$ (at $t=0$) to $z=-ia -iy +d$ (at $t= 2(y+a)$) One can see that the graph goes to $\pm 2.35619 $ at $t=0$ and at $t= 2(y+a)$ - Why? Shouldn't it be going toward $\pm \pi$ at these two values of $t$? (given that the imaginary part of the function $\log(z^2+a^2)$ approaches $\pm i\pi$ on the right and above/below $\pm ia$) * * * If I don't set a value for $d$ (the distance from the branchcut) and take the limit of $d \rightarrow 0$ at $t=0$ and $t=2(y+a)$ then Mathematica returns the expected values of $\pm \pi$ - but no matter how small a value of $d$ I fix (now independent of the value of $y$) the graphs still can't show the value of $\pi$ at $t=0$ though it gets the other end right.


How can I get a PieChart to be colored as I wish?

How to use the value of a funtion[label] to assign color to a piece of the pie? (edited after answer of kguler ) My dude is how to control the colors in ranges of a function of [labels] In this way I can show: 1.- the percentage of Data(labels), using pieces of pie and 2.- the value f of labels, with range colors (similar to TemperatureMap but customized) ![Use a funcion of Data-Labels to control the color os pieces](http://i.stack.imgur.com/CTHs3.jpg) \------ Original Post ------ I want to use a "gradient" or "a reduce (5-6) list of colors"(similar to DarkRainbow with a little colors)? I was trying with ColorData and ColorDataFunction ( here you can see that I obtain errors with the same code as the reference doc ) but I have no succes!!               percent = {12, 18, 24, 46}     labels = {1, 9, 15, 22}     f = {8, 7, 1, 4}     PieChart[percent, ChartLabels -> labels, ImageSize -> 200, PlotLabel -> "Test-Grad",  ChartStyle -> ColorData["TemperatureMap" {0, 8}]]     PieChart[percent, ChartLabels -> labels, ImageSize -> 200, PlotLabel -> "Test-Comic", ChartStyle -> ColorData[9, "ColorList"]]      In the image you can see any more about explanation: ![enter image description here](http://i.stack.imgur.com/HJCIR.jpg)


Get positions of all non zero matrix elements

I want to find all non zero elements of a table and I want to create a list that contains the name of the table the element was removed from, the position of the element, and the value of the element. Then to the generated list I would like to apply a replacment rule to the row and the column.               rule = {1 -> "a", 2 -> "b", 3 -> "c"}          { {tablename, row, col, value} }      For example I have tried               dataTable1 = {{1,0,0}, {0,1,0}, {0,0,-1}}           Position[Abs[dataTable1], # > 0 &]      but I am unable to get get the position. I would like the final out put to be                { {"dataTable1", 1,1,1}, {"dataTable1", 2,2,1}, {"dataTable1", 3,3,-1} }      If we apply the replacment.                 { {"dataTable1", 1,1,1}, {"dataTable1", 2,2,1}, {"dataTable1", 3,3,-1} } /. rule       Then the output should be                { {"dataTable1", "a","a",1}, {"dataTable1", "b","b",1}, {"dataTable1", "c","c",-1} }


Why TeXForm[] do not display to notebook if followed by OutputForm[] in same cell?

Can someone please explain to me the logic of this: In one cell, when writing               eq = D[y[x], x] + a*y[x] - b*Sin[c*x];     sol = DSolve[eq == 0, y[x], x];     TeXForm[sol]     OutputForm[TeXForm[sol]]      I see only the result of `OutputForm`: ![Mathematica graphics](http://i.stack.imgur.com/7iLnb.png) But in separate cells, then I see both outputs ![Mathematica graphics](http://i.stack.imgur.com/ps1kB.png) ps. I was trying to find how to remove the "\" at the end of the `OutputForm` compared to `TeXForm` output, and that is why I am doing the above, to compare the outputs. This happens on both V9 and 10. Should not both output show up, even if in the same cell?


How to get rid of the blank areas around alphabetical images?

I attempt to test the mean graylevels of the alphabets "W" and "Z". I used the following code to create the images of them.               imW = Rasterize@       Graphics[         Text[Style["W", 24, FontFamily -> "Helvetica",           TextAlignment -> Center, Antialiasing -> True], {0, 0}],         ImagePadding -> 0, ImageSize -> 24]          imZ = Rasterize@       Graphics[         Text[Style["Z", 24, FontFamily -> "Helvetica",           TextAlignment -> Center, Antialiasing -> True], {0, 0}],         ImagePadding -> 0, ImageSize -> 24]      However, there are blank areas around the images. How can I get rid of them? Is there a trim function built in for this purpose? ![enter image description here](http://i.stack.imgur.com/Grr5I.gif) I tried `ImageCrop[imW ]`, however, the top and bottom blanks still left. @kirma I did follow your suggestions, both increasing the `ImagePadding` to 20, and `ImagePad[img, -BorderDimensions[img]]`. Somehow, I still can't get rid of the top and bottom blanks. What I got was something like this: ![enter image description here](http://i.stack.imgur.com/2zVxo.gif)


I need to cite the same reference several times. Mathematica citation manager messes up

Mathematica cannot seem to properly number citations when there are several citations to the same reference. Is there some trick to make this work?


Data filtering using Butterworth filter

I want to filter data using Butterworth filter. I am currently using Matlab and I want to know how to do it in Mathematica. I have the following data:               data1 = Table[        PDF[NormalDistribution[3.5, .8], i] +          PDF[NormalDistribution[6, 1], i], {i, -5, 15, .01}];     noise = RandomReal /@ RandomReal[{-0.2, .2}, Length[data1]];     data2 = data1 + noise;      I filtered this data using Matlab as follows:               [b,a] = butter(8,0.04);          filtfilt(b,a,data2 );      In the previous question's answer, bill s suggested to do it as follows in Mathematica:               RecurrenceFilter[      ToDiscreteTimeModel[ButterworthFilterModel[{2, 0.04}], 1], data2      ]      The result is as follows: ![enter image description here](http://i.stack.imgur.com/9JyX7.jpg) The problem I am facing is whatever I change the filter order and frequency, I am not able to produce the same filtered data as I am getting from Matlab. Can someone suggest for me what to do and what values to use to get the same filtered data as I am getting from Matlab? Thanks


Evaluate differentiation after replacement

The problem is Find two linearly independent solutions of $2x^2y'' -xy' + (-4 x + 1)y = 0, \, x>0$ of the form $y_1 = x^{r_1}(1 + a_1 x + a_2 x^2 + a_3 x^3 + \cdots)$ and $y_2 = x^{r_2}(1 + b_1 x + b_2 x^2 + b_3 x^3 + \cdots)$. What I have done is below:               2 x^2*D[y, {x, 2}] - x D[y, x] + (-4 x + 1) y == 0 /. y -> x^r*(Sum[C[n]*x^n, {n, 0, 5}])      The result mathematica gave is               (1 - 4 x) x^r (C[0] + x C[1] + x^2 C[2] + x^3 C[3] + x^4 C[4] + x^5 C[5]) == 0      from which I conclude that `D[y,x]`is excuted before the replacement. How can I make `D[y,x]` excute after the replacement?


Why is Mathematica getting this modular root wrong?

First, note that $4^{96}\equiv96\ (mod\ 100)$. _Mathematica_ claims that `PowerMod[96, 1/96, 100]` has no integer solutions. Even more obviously wrong, I get `{}` for               Solve[4^96 == x^96, Modulus -> 100]      which obviously has at least one solution (4). Is this a known bug? Can I work around it somehow? EDIT: I'm on _Mathematica_ 9.0.1, running on OSX 10.10 Yosemite developer beta. Perhaps that could be the cause of this issue for me (also, mathematica crashes whenever I try to paste.).


Multiple Mathematica notebooks in a tabbed window with line numbers

I have the following questions: Is there a way to open multiple mathematica notebooks in tab group rather that each mathematica notebook opened in separate window? Is there a way to display line numbers in mathematica notebooks as line numbers are displayed in differnt text editors?


Change appearance of ConvexHullMesh

I'm struggling to understand the behaviour of `ConvexHullMesh` (or rather the non-behaviour). I have a polynom `p`               p = { {0, 0}, {1, 0}, {1/2, 1/2}, {1, 1}, {0, 1}}      which I can display in a nice way like by e.g.:               Show[Graphics[{LightBlue, EdgeForm[Gray], Polygon[p]}],  Graphics[ {PointSize[Large], Red, Point[#]}] & /@ p]      Now I construct the convex hull               q = ConvexHullMesh[p];      which displays a somewhat featureless rectangle. Having a closer look at `q`               q // InputForm      I get > BoundaryMeshRegion[{{0., 0.}, {0., 1.}, {1., 0.}, {1., 1.}}, {Line[{{1, 3}, > {3, 4}, {4, 2}, {2, 1}}]}, Method -> {"EliminateUnusedCoordinates" -> True, > DeleteDuplicateCoordinates" -> Automatic, "VertexAlias" -> Identity, > "CheckOrientation" -> True, "CoplanarityTolerance" -> Automatic, > "CheckIntersections" -> Automatic, "BoundaryNesting" -> {{0, 0}}, > "SeparateBoundaries" -> False, "PropagateMarkers" -> True, "Hash" -> > 1136472811504667718}] so the obvious (?) idea is to replace the head of `q` (i.e. `BoundaryMeshRegion`) by a suitably defined function `f` that uses the argument to display the convex hull in a 'nicer' way. Ignoring the exact implementation of `f`, the 'usual' way fails, as               f @@ q       just redisplays the rectangle. `Head[q]` gives the expected `BoundaryMeshRegion`, but `Apply` (or `@@`) somehow fails to replace the head. Similarly, the alternative `q[[1]]` to access the argument of the head fails. What am I missing? Or to be more precise:   * How do I change the appearance of `ConvexHullMesh`?   * Why does the above solution not work?


How can I track the execution time of an evaluating Manipulate cell?

In Wolfram's tutorial on Advanced Manipulate Functionality, a nice example of a continually evaluating `Manipulate` cell is presented:               Manipulate[       f[x_] := x^3;       Graphics[{Thickness[0.01], Line[{{0, 0}, {n, f[n]}}]},          PlotRange -> 1],       {n, -1, 1}]      If I wrap `Timing[]` around this example I get list of `0.` along with the continually evaluating `Manipulate` cell. Now can anybody make a clock that will show increasing time of evaluation of such a `Manipulate` cell? In case the `Manipulate` cell has finite execution time, the clock would show time elapsed for this execution. The motivation behind is to have measure of slow `Manipulate` cell execution.


How to create 'help' `?` for a function (as documentation)

I have defined a function `PassVeltB` in some complicated way. But now I would like to add a little documentation that gives the user information on how it is to be used. I know that the `?` symbol could be placed before a built-in function to generate useful information about that built-in function. Is there a way I can add helpful information about my `PassVeltB` function in a similar way?


A notebook created on demand from a main document showing executable input along with output cells

I would like to make _Mathematica_ documents with hidden calculations, such that they can be visualized on demand. In general it can be done in several forms and I actually use some. I would like to ask about one specific way of doing that. Namely, I would like to make a button incorporated into either inline or input cell. Upon pressing on this button a separate notebook should open containing the calculations. It is easy to make this, if the document only contains output cells. For instance, this               button1[expr_, sz_] := Button["Evaluate expression",        CreateDocument[expr, WindowSize -> {sz, sz}]];          button1[Expand[(x + y)^2], 300]      makes a button which opens the window with the result `x^2+2xy+y^2`. It is easy to make a notebook with a cell that can be later evaluated:               button2[expr_, sz_] := Button["Evaluate expression",        CreateDocument[         ExpressionCell[expr, "Input"],         WindowSize -> {sz, sz}]];     button2[Expand[(x + y)^2], 300]      but it also returns the already evaluated result. For whatever reason this:               SetAttributes[button2, HoldFirst];      does not help. One can also show the both unevaluated input and the output like this:               button3[expr_, sz_: 300] :=       Button["Show expression",        nb = CreateDocument[            {ExpressionCell[Unevaluated[expr], "Input"],            ExpressionCell[Button["Evaluate", Print@Evaluate[expr]],             "Input" ]},          WindowSize -> {sz, sz}          ]];     button3[Expand[(x + y)^2]]      However, I would like to get rid of the operator `Unevaluated` in the first cell. My aim is to get a separate notebook that is generated from the initial document. This notebook should have an input and the corresponding output cell (or cells), which a) shows how some result has been achieved in the past and what was this result and b) in which I could try to change something in the input cell(s) and see what would happen, while the source code lays somewhere unchanged. Thank you, Alexei


FindMaxValue vs FindMaximum

I'm studyng the maximum value of the following function               k = hbar^2*rhoc/(2*m)          Esf2[x1_?NumericQ, zeta_?NumericQ] :=          k*NIntegrate[(1. - r^2)*(Tanh[(1./zeta)*Sqrt[(4.*Log[2.] - 1.)/3.]*         Sqrt[(1. - x1^2) (Abs[r Sin[t]]^2 + (x1 - r Cos[t])^2)]]^2          Tanh[(1./ zeta)*Sqrt[(4.*Log[2.] - 1.)/3.]* Sqrt[(1. - x1^2)          (Abs[ r Sin[t]]^2 + (x1 + r Cos[t])^2)]]^2)*((4 x1^2 (-1. + x1^2)^2          (1. + r^4 + 2 r^2 Cos[2. t]))/((r^2 + x1^2 - 2 r x1 Cos[t])          (1. + r^2 x1^2 - 2 r x1 Cos[t])(r^2 + x1^2 + 2 r x1 Cos[t])          (1. + r^2 x1^2 + 2 r x1 Cos[t]))),         {r, 0., 1.}, {t, 0., 2.*Pi}]      with FindMaximum:               maxEvalue[zeta_?NumericQ] := FindMaximum[{Esf2[x1, zeta], 0 <= x1 < 1}, {x1, 0.02}]      The problem with FindMaximum is that it strongly depends on my starting point (in this case 0.02). For Example, if you run the following:               Do[Print[maxEwaarde[zeta]], {zeta, 0.01, 0.1, 0.01}]      you see that the maximum is always on the same x1 position. And if you plot the Esf function, you see that FindMaximum gives the wrong position!               zetac = 0.0311     Plot[Esf2[x1, zetac], {x1, -0.2, 0.2}, AxesOrigin -> Automatic]      When I use FindMaxValue, it looks like its giving me the right maximum, only now I can't study the evolution of the x position.               maxblabla[zeta_?NumericQ] := FindMaxValue[Esf2[x1, zeta], {x1, 0.001, 0.002}]     maxblabla[zetac]      Does somebody now what I am doin wrong with FindMaximum? Or how i can get FindMaxValue to give me the x position? Thanks a lot!!!


Limit of a subsequence

I am trying to calculate limit for a subsequence <${ a }_{ {n }^{ 2} }$> because I was trying to see that limits of sequences and subsequences are both same. I was able to generate the sum for square values as,               N[ Sum[ 1/(n (n + 1)), {n, Table[n^2, {n, 1, 1000}]}]]      But I want to know how I shall find limit to a subsequence of square integers.


Defining a non-commutative operator algebra in Mathematica

I am trying to develop a function(s) to do some commutator algebra to compute the enveloping algebra and ideals of a Lie algebra. For example if I have $SU(2)$ algebra generated by $L_i$ ($i=1,2,3$), I would like to evaluate commutators between polynomials of type $L_1^mL_2^nL_3^p$ where $m,n,p$ are integers. Now I think I should start by defining a commutator function as a mapping which is: (a) antisymmetric, (b) is a derivation (Leibniz property), and (c) satisfies Jacobi identity. Since I do not want to plug in explicit realizations for the operators, defining commutator $[A,B] = AB - BA = C$ would not really help. I want to define commutator as a rule which would just assign $[A,B] \rightarrow C$ and when computing $[A,BC] \rightarrow [A,B]C + B[A,C]$ and so on. I tried by defining something with Leibniz property as follows:               Comm[a_**b_, c_**d_] := a**Comm[b, c]**d + a**c**Comm[b, d] + Comm[a, c]**d**b +                              c**Comm[a, d]**b;      This works fine for evaluating $[a,bcd]$ but it doesn't do anything to $[abc,d]$ for example. So I am wondering what should I do to correctly define this and how would I go about to define this mapping with the desired properties.


How to find a particular solution using NDSolve

I'm looking for a way to find a specific solution to a differential equation. As a simplified version of my problem, here's a similar setup for a simple harmonic oscillator problem.               aargh =        NDSolve[{        -0.000000000001 + q''[x] == -q[x],         q'[π] == q'[-π], q[-π] == q[π]},         q, {x, -π, π}];     Plot[Evaluate[q[x] /. aargh], {x, -π, π}]      The reason for the 0.00000000001 is to perturb the system slightly to ensure that I get a nonzero solution. This gives a beautiful harmonic function as a solution. Now, what I want to do, is specify a starting trial solution for `NDSolve` to look around. For example, say I wanted to find the $\sin(x)$ solution to the differential equation. Is there any way by which I can specify this and ask _Mathematica_ to look around a particular function for my solution. My actual problem is far more complicated, but is essentially the same. It is also homogenous, so I've added a perturbation there as well to find the non zero solution. Once again, _Mathematica_ is returning an approximately valid solution, but I know that there exists another solution somewhere else. How do I tell _Mathematica_ to look there?


How to let output and message be print to two separate external files? Also, I'd like the content print out to have similar look as when it's print inside the notebook, i.e. it should be in OutputForm or whatever proper form.


How to extract expression from ConditionalExpression

p1 := y /. {First[Solve[x^2 + y^2 + x == 1, y, Reals]]}      > >     {ConditionalExpression[-Sqrt[1 - x - x^2], >        1/2 (-1 - Sqrt[5]) < x < 1/2 (-1 + Sqrt[5])]} >   I want to get the `-Sqrt[1 - x - x^2]` out of the conditional expression and assign it to a variable. I don't care about the conditions, I'm aware of them and need the expression for use out of the `ConditionalExpression`. How do I do that? I tried list commands combinations (`Flatten`, `First`, etc.) but they don't work with this. Am I just supposed to copy-paste?


How to obtain a function from a implicit equation?

I have               (60 - r/2) (70 - ca - r/2) - (60 - r/2 - ca + (4/25) (70 - r/2 - ca))*(70 - r/2)==0     Reduce[%, {ca}]      But How could I obtain directly a function as ca[r_] :=...?


Create Table of replacement rules

I want to create a table of replacement rules.               g[a_, b_] := a -> b          t1 = Table[10 i + j, {i, 5}, {j, 3}]     t2 =  Table[ i + j, {i, 5}, {j, 3}]           g[  # & @@@ t1, # & @@@ t2 ]      The correct output is below:               {{11 -> 2, 12 -> 3, 13 -> 4},      {21 -> 3, 22 -> 4, 23 -> 5},      {31 -> 4, 32 -> 5, 33 -> 6},      {41 -> 5, 42 -> 6, 43 -> 7},      {51 -> 6, 52 -> 7, 53 -> 8}}      Instead I am getting:                 {11, 21, 31, 41, 51} -> {2, 3, 4, 5, 6}      Which shows two concepts I am still trying to wrap my mind around how to accomplish in _Mathematica_. In a 2-d list how to you select each row, and then perform an operation on each element of that row ( in this case take that element and make a rule replacment a -> b). Then iterate through every row.


efficient way to give nearest neighbour and next nearest neighbour of every point in a point set

Suppose we have a point set, the points are labeled 1,2,3,....n. And `p[i]` is the coordinate of the point. Now I want the label of nearest and next nearest point (maybe several) corresponding every point in this point set. For example:               p[1] = {0, 0};     p[2] = {0, 1};     p[3] = {1, 0};     p[4] = {0, 5};      and I want a list for nearest neighbour like this:               {{2, 3}, {1}, {1}, {2}}      it means that `p[2]` and `p[3]` is nearest to `p[1]`, `p[1]` is nearest to `p[2]`, etc. And I need a similar next nearest neighbour list. I write the following code:               num = 5000;     Do[p[i] = RandomInteger[{1, 100}, 2], {i, 1, num}];          coolist = Table[p[i], {i, 1, num}];          Clear[position];     position[expr_] :=        With[{positionData =           SortBy[#[[1, 1]] -> #[[All, 2]] & /@              GatherBy[              Extract[expr, #, Verbatim] -> # & /@                Position[expr, _, Depth[expr]], First],             Min[Length /@ #[[2]]] &] // Dispatch},         Replace[#, positionData] &];          poscoolist = position[coolist];          Clear[nnsite];     nnsite[k_, coolist_] := Module[{nncoolist},        nncoolist = Nearest[Complement[coolist, {p[k]}], p[k]];        Flatten@         Table[poscoolist[nncoolist[[i]]], {i, 1, Length[nncoolist]}]];          nearestlist = Table[nnsite[i, coolist], {i, 1, num}]; // AbsoluteTiming          Clear[nnlabel];     Thread[Evaluate@Array[nnlabel, num] = nearestlist];          Clear[nnnsite];     nnnsite[k_, coolist_] := Module[{nnncoolist},        nnncoolist =          Nearest[Complement[           Delete[coolist, Partition[nnlabel[k], 1]], {p[k]}], p[k]];        Flatten@         Table[poscoolist[nnncoolist[[i]]], {i, 1, Length[nnncoolist]}]];          nextnearestlist =         Table[nnnsite[i, coolist], {i, 1, num}]; // AbsoluteTiming      the function `position` in the above code is provide by Mr.Wizard (see here). `nearestlist` and `nextnearestlist` give the result. Notice to use my code, supply every coordinate p[i] of points. For 5000 points, it takes 1 minutes. But for 10000 points, it takes 6 minutes. Quite long! I feel that my code is so simple, there must be better ways that are more efficient.


Extracting data values from a plot

I found that the fact is very useful that a plot sometimes contains all the original data needed to reconstruct that plot. This is very helpful for me because sometimes I need to retrieve and analysis the numerical data in plots I produced in the past. It's much easier for me(in the sense of organization of projects) to just save the plots in notebooks rather than save the numerical data in some separated files. For example:               data1 = {{1., 2.}, {2., 3.}, {3., 1.}};     pic1 = ListPlot[data1, Joined -> True]      ![enter image description here](http://i.stack.imgur.com/0hqvW.png) I can get the data back using               Cases[pic1, Line[x__] -> x, ∞]     (* {{{1., 2.}, {2., 3.}, {3., 1.}}} *)      This works great most of the time, but sometimes when I specified a plot range, some data are lost:               data2 = Table[{x, Cos[x]^2}, {x, -π/2, π/2, π/8}] // N;     ListPlot[data2, Joined -> True]     pic2 = ListPlot[data2, PlotRange -> {{0, 1.5}, {0, 0.5}}, Joined -> True]      ![enter image description here](http://i.stack.imgur.com/D9K9y.png) ![enter image description here](http://i.stack.imgur.com/aqUzt.png)               Graphics[Cases[pic2, _Line, ∞], AspectRatio -> 1/GoldenRatio, Axes -> True]      ![enter image description here](http://i.stack.imgur.com/fsVg8.png) Note that the data are lost only at the vertical direction. So are there ways to tell Mathematica to save all the data into the plot?


Import Excel data forcing links (ie workbooks) to be updated

We have noticed importing data from an Excel spreadsheet doesn’t update links. The problem with this is if you import a spreadsheet that comprises of linked workbooks data and those workbooks have been updated then stale data is retrieved. ![enter image description here](http://i.stack.imgur.com/SFHa6.png) Opening workbooks using the Excel Object Model does support a parameter to UpdateLinks. ![enter image description here](http://i.stack.imgur.com/kpJUf.png) Is there an undocumented way to force Mathematica to open spreadsheets and update the links?               Import["c:\\temp\\Exercises.xlsx",{"Sheets","Sheet1"}][[1;;18;;1, 1;;16;;1]];


ScientificForm problem

Consider this code:               ScientificForm[1., 8, NumberFormat -> (Row[If[#3 == "", {#1, "E", 0}, {#1, "E", #3}]] &)]     (* 1.E0 *)          ToString@ScientificForm[1., 8, NumberFormat -> (Row[If[#3 == "", {#1, "E", 0}, {#1, "E", #3}]] &)]     (* 1.E0E0 *)      Why is there an extra "E0" in the second output?


Editable keyframe curves

Any suggestions for a good approach to implementing a zoomable 'keyframe' based curve editor? Essentially, something akin to the functionality of the graph editor in animation packages such as Maya. (see here). I can see how to get started on something simple using Locators, but the ability to zoom and pan on long time ranges is something that looks tricky to me, and I suspect starting out with the right concept in the first place will save a lot of headaches...any ideas much appreciated.


How to combine notebook into one cell

I want to have my entire notebook be a conditional while statement. However, I don't want to merge all of my cells together, as it is a long and detailed process. Is there a way to create another cell that encompasses all of the smaller cells in my notebook?


Is it possible to plot a function using Plot3D and a curve using ParametricPlot3D in the same picture?

I'd like to plot a graph of a function using e.g. `Plot3D` and then a line (in general a curve, in my case a straight line, tangent at some point to the surface just drawn), using e.g. `ParametricPlot3D` _in the same picture_. Is it possible? If yes, how?


How can I set the tick marks of the x axis in RectangleChart?

By default, the x-axis in `RectangleChart` is not labeled. Using `Axis -> {True, True}` does not help. Can I set the ticks manually?


Is there possibility of exporting mathematica code directly into Latex?

I'm novice very user of Mathematica - is there possibility of exporting mathematica code directly into Latex - I'm interested only in exporting mathematical formulas ? And from which version of program is it possible ?


I have a question about using a recursive function in a module. I made the following example to illustrate the question. The followwing code works:               Clear[fib]     fib[1] = 1;     fib[2] = 1;     fib[n_] := fib[n - 1] + fib[n - 2]     f[a_, b_, n_] := Module[{x, y},     fib[1] = a;     fib[2] = b;     x = fib[n];     Print[x];     fib[1] = 2 a;     fib[2] = 2 b;     y = fib[n];     Print[y];     x + y     ]     f[1, 1, 3] = 6.      but is slow, I want to use memoization, i.e.               fib[n_] := fib[n] = fib[n - 1] + fib[n - 2]       but in that case               f[1, 1, 3] = 4.       **Question: How can I use a recursive function in a Module?**


Evaluating an ItoProcesss function

The following is my Stochastic D.E.:               proc = ItoProcess[{\[DifferentialD]n[t] ==          sigma*Sqrt[(2*Um)/(Pi*L)]*\[DifferentialD]w[             t] - (\[DifferentialD]t*(Um*n[t]))/L}, n[t], {n, 1}, t,           Distributed[w, WienerProcess[]]]      I would like to find the value of `n[0.1]`. Can someone kindly guide me as to how I can do so? Thanks!


Solving recurrence sequence using an ODE

I'm trying to solve the recurrence               a[n] == 0 for n < l     a[l] == 1     a[n] == (l + 2(n - l) a[n - l] + (n - l)(n - 1) a[n - 1])/n(n - l + 1) for n >= l      using the ODE               l = 2;     DSolve[(x^2 y''[x] + (2 - l) x y[x]) (x - 1) + 2 x^(l + 1) y'[x] + (l x^l)/(1 - x) == 0,        y[x], x]      For `l = 2` it works, but not for `l > 2`. Is it possible to do it? Maybe there is another way to solve this recurrence ?


ListPlot3D of a set of points in a non-convex region

I would like to plot a set of points in the same style as `ListPlot3D` does, but only in a non-convex region that I can specify (e.g. using a `RegionFunction`). Is there a simple solution for this? Let me illustrate with an example. Let's generate some sample points ...               Clear[regionFun]     regionFun[{x_, y_}] := y < x^2          fun[{x_, y_}] := -Norm[{x, y} - {.5, .5}]          pts = Select[Tuples[Range[0, 1, 0.01], 2], regionFun];      ... and try to plot then in the region we're interested in:               ListPlot3D[      Append[#, fun[#]] & /@ pts,      RegionFunction -> Function[{x, y}, regionFun[{x, y}]],      InterpolationOrder -> 1     ]      ![enter image description here](http://i.stack.imgur.com/HJoc1.png) Notice that the plot occupies the complete convex hull of the points because of how the Delaunay triangulation was constructed for the interpolation. What I would like to see instead is this:               Plot3D[fun[{x, y}], {x, 0, 1}, {y, 0, 1},       RegionFunction -> Function[{x, y}, regionFun[{x, y}]]]      ![enter image description here](http://i.stack.imgur.com/NyhSR.png) The only possible solution I see at the moment is to use an external tool to "manually" construct a Delaunay triangulation which is confined within a region and build the plot from that data. This, however, is a lot of work, so I thought I'd ask first if there's a simple solution. Note that this is just a generated example dataset, not my real data. I can't use `Plot3D` for my real application, only `ListPlot3D` and related functions.


How to draw a tangent to a surface in a given direction?

It seems quite embarrassing for me, but somehow I can't draw a tangent line to a surface in a given direction. Assume that I want to visualize directional derivative of the function, say, $(x,y)\mapsto x^2+y^2$, at the point, say, $(1,0.5)$. I tried this:               F[x_, y_] := x^2 + y^2          Manipulate[      Show[{Plot3D[F[x, y], {x, -2, 2}, {y, -2, 2}]},           {ParametricPlot3D[{Cos[phi]*t,Sin[phi]*t,              ((D[F[x, y], x] /. x -> 1 /. y -> 0.5)*Cos[phi]              + (D[F[x, y], y] /. x -> 1 /. y -> 0.5)*Sin[phi])*t},           {t, 0, 2}, PlotStyle -> Thick]}], {phi, 0, 2*Pi, Pi/4}]      to no avail. (I am a bit afraid that I did make some stupid _mathematical_ error; unfortunately, Mathematica's syntax is a bit "perlish" to me: I'm learning to write in it, but have serious difficulties reading it...) My question is twofold: (1) what is wrong with the above code and (2) what is a "canonical" (read: elegant and possibly fast) way of doing this?


How to get monomials multiplied by each other?

Suppose `Subscript[x, #] & /@ {1, 3, 7}` that returns `{x_1,x_3,x_7}`. Now how can I get `x_1x_3x_7`? **Tried it already**... > ![enter image description here](http://i.stack.imgur.com/sNyDN.png) _P.s. I am trying to understandthis thread deeper about converting binary mlfs to mlfs._


Conversion of binary matrix of mlf into multilinear function, any ready function for this?

I convert here only one term $x_1x_3x_7$ from the binary matrix by first getting the reversed binary 1010001 and then miggling with the data. I know I could convert the columns into binaries and then use solutions here but I feel there must be something builtin: I am trying to convert binary form of multilinear function simply to its symbolic form where the MLF is expressed as a matrix below.. > **Is there anything built in to convert the binary matrix into the > corresponding multilinear function?** **Input** > ![enter image description here](http://i.stack.imgur.com/1YkK8.png) **Intended output** > > $x_1x_3x_7+x_1x_3x_5x_6+x_1x_4x_7+x_1x_4x_5x_6-x_2x_3x_7-x_2x_3x_5x_6-x_2x_4x_7-x_2x_4x_5x_6$


Already solved DE, now I need to rearrange and plot

I have solved for $z(w,x,y)$ in a differential equation: $$ 3\frac{\partial z}{\partial y} = 2(z-1) + (1-wy^2 )x $$ And I obtained the general solution: $z = f(w,x,y)$ Now putting in $x=0$, we have $z_0 = f(w,0,y) = g(w,y)$ Then I am trying to solve for $x^*(w,y)$ this final equation and contour plot it: $$ f(w,x^*,y) = 2.7 \times g(w,y)$$ I've managed to obtain $f(w,x,y)$ and $g(w,y)$, which should be the hardest part. Then I'm not sure why the last part of the code is not working, as the last part should be rather straightforward.               pde1 = 3*D[z[w, x, y], y]  == 2 (z[w, x, y] - 1)  + (1 - y^2 w) x     soln1 = DSolve[pde1, z[w, x, y], {w, x, y}]     soln5 = soln1 /. {x -> 0}     eqn1 = soln5  == 2.7*soln1     ContourPlot[      x /. Solve[eqn1, x, Method -> Reduce], {w, 1, 5}, {y, 1, 5},       PlotRange -> All]


Cell format for screen headers

If one picks the menu option Format->Edit Stylesheet and then one opens the "Default.nb" link, the newly opened notebook has a header that reads "Deafult.nb" style definitions. In one navigates down in the page, that header stays in place. However, none of the header styles defined in Default.nb produce that specific header. What is the style to produce that type of static header? What are the menu commands (if any) to dock cells?


How do you put a plot inside a popupmenu that is inside another popupmenu?

I have the next code                Manipulate[          Switch[x, a, If[selection =!= None, selection = None], b,              If[selection === None, selection = None], c,              If[selection === None, selection = "Hola"]      ];      selection, {x, {a, b, c}, ControlType -> PopupMenu},        {{selection, None},           Switch[x, a, {"recta", "parabola"}, b, {"hiperbola", "absoluto"},           c, {"Seno", "Coseno"}], ControlType -> PopupMenu}      ]      but I need you to choose the second popupmenu I plot the function chosen.


Kinect on Mathematica

I saw on the internet a lot of nice experiments with Microsoft Kinect. I just bought one and would like to know if someone here has been able to use it with Mathematica. The main idea is to been able to use it as another controller device. So you could get it state using `Dynamic@ControllerState` Mathematica command. In some way, it's necessary to install a driver that make this possible. I installed zigfu and synapse-kinect on my mac (see links below). They demo worked just nice, but no additional device appeared on my Mathematica. You can list connected devices using the `ControllerInformation[]` command. ![enter image description here](http://i.stack.imgur.com/iq2ld.png) Here are some links with potential starting points, as suggested in the comments: http://zigfu.com/en/downloads/browserplugin/ http://www.shiffman.net/p5/kinect/ http://developkinect.com/resource/application/synapse-kinect http://glovepie.org/forum/viewforum.php?f=32


Implementation of Decompose

I'm curious as to how `Decompose` works so I decided to use `Trace` with the option `TraceInternal -> True`. For `NextPrime`, this works well:               AppendTo[$ContextPath, "NumberTheory`NextPrimeDump`"];     Trace[NextPrime[45],TraceInternal->True]          {NextPrime[45],     {Block[{res},res=integerNextPrime[45];RuleCondition[res,IntegerQ[res]]],     {res=integerNextPrime[45];RuleCondition[res,IntegerQ[res]],     {{integerNextPrime[45],{Block[{res},res=45+1+Mod[45,2];     While[!PrimeQ[res],res+=2];RuleCondition[res,IntegerQ[res]]],     {res=45+1+Mod[45,2];While[!PrimeQ[res],res+=2];RuleCondition[res,IntegerQ[res]],     {{{Mod[45,2],1},45+1+1,47},res=47,47},{While[!PrimeQ[res],res+=2],     {{{res,47},PrimeQ[47],True},!True,False},Null},     {{{res,47},IntegerQ[47],True},RuleCondition[res,True],res,47},47},47},47},res=47,47},     {{{res,47},IntegerQ[47],True},RuleCondition[res,True],res,47},47},47},47}      Above, we can see some code and get an idea of how `NextPrime` works. But when I do this with `Decompose` I get something weird:               With[{p = Expand[(x^2+x+1)^2+2(x^2+x+1)+1]},       Trace[Decompose[p, x], TraceInternal -> True]     ]          {Decompose[4+4 x+5 x^2+2 x^3+x^4,x],{BitAnd[29,8],BitAnd[8,29],8},     {BitAnd[29,4],BitAnd[4,29],4},{BitAnd[29,2],BitAnd[2,29],0},     {BitAnd[29,1],BitAnd[1,29],1},{BitAnd[14,4],BitAnd[4,14],4},     {BitAnd[14,2],BitAnd[2,14],2},{BitAnd[14,1],BitAnd[1,14],0},     {BitAnd[31,8],BitAnd[8,31],8},{BitAnd[31,4],BitAnd[4,31],4},     {BitAnd[31,2],BitAnd[2,31],2},{BitAnd[31,1],BitAnd[1,31],1},     ....,     {4+4 x+x^2,x+x^2}}      Is there any way to tell where these bitwise ANDs are coming from? Isn't `TraceInternal` supposed to show all workings during an execution?


Highlighting bracketing in Mathematica

I'm working with lists of lists of lists. Each box with information has a specific format like                 information = {{a},{{b}},{{{c},{d}},{e,{f}}},{g}}      and so together they look like                 {{{a},{{b}},{{{c},{d}},{e,{f}}},{g}},{{h},{{i}},{{{j},{k}},{l,{m}}},{n}},...      and this goes over the whole screen. I want to make the inner and outer brackets in an expression like **{{** a **}}** look different, possibly down to all levels. Is there a way to highlight the bracketing in such a way that I can _see_ the different levels of the list?


Creating a Dynamic MSSQL connection

Hello i am trying to create a notebook that automatically connects to a database on MSSQL server and would then query this to create a sort of personal report. I have connected to this database and run a few queries ok but i am having trouble with getting it to load when i open the notebook.               Needs["DatabaseLink`"];     Dynamic[         conn=OpenSQLConnection["TSQL2012"]]          myOrder =SQLExecute[Dynamic[conn], "select custid, shipcountry from Sales.Orders where orderid = '10248'", "ShowColumnHeadings" ->True] //TableForm      I have been trying code such as the above but i think the Dynamic connection is trying to open to many connections to the database and then it crashes. Running the code above without the Dynamic elements in place works fine. is there a way to connect to DB when a notebook is opened and use this in SQLExecute statements?


Why doesn't FullSimplify get rid of the common factor in this expression?

`FullSimplify` does not get rid of the `z` factor in the following expression:               FullSimplify[(E^(-I x) y z + (1 + E^(I y)) (x + y) z)/z, z != 0]      Upon removing a single piece of the expression, such as the first `y` factor or the `1+` in the brackets, the simplification suddenly succeeds. As far as I can tell it is only this special combination of variables that fails. Is there any obvious problem with simplifying this?   Is there a way to tweak the `FullSimplify` function to make it succeed? (this is just a part of a longer expression - and I want to avoid looking for such problems manually). I'm using _Mathematica_ version 9.0.0.0 on Win7 64 bit.


Nonsense Data with Wolfram Alpha + Mathematica?

I am trying to learn how to interface with WolframAlpha. When I try using the Mathematica interface I get nonsensical data. I don't know if this is a bug or if I'm doing it wrong. My goal is to extract the elevation around the Austrian Province of Upper Austria. Perhaps to assert that Upper Austria is not actually the highest Austrian province, if this doesn't work I will attempt to challenge the status of Lower Austria. My Wolfram Alpha reference query is:               http://www.wolframalpha.com/input/?i=average+elevation+around+upper+austria+Austria      My Mathematica code is:               WolframAlpha["average elevation around Upper Austria, Austria \     (state)", {{"ElevationStatistics", 1}, "ComputableData"}]      which gives               {{"average", -(27896275/24384)}, {"lowest", -(3662500/        381)}, {"highest", 2585000/381}}      which can't be right by any measure. What's going on?


Represent Plot Scale with an offset

I want to know how to represent the axis on my 3dplot with a scaled offset. Please see the image below, I just want to show in the plot as {X-Axis*0.1} and {Y-Axis*0.1} ... ![enter image description here](http://i.stack.imgur.com/vKEnC.png)


Speeding up trigonometric integral

**Context** On a possible non trivial toric topology for the Universe (nothing less!). **Problem** I would like to carry out the following integral for $\ell=2,4\cdots 20$. $$\int _0^{\pi }\int _0^{2 \pi } \sin(\theta ) P_{\ell }\left(\frac{1}{2} \sin(\theta ) (\cos(\phi )-\sin(\phi ))\right) P_{\ell }\left(\frac{1}{2} \sin(\theta ) (\cos(\phi )+\sin (\phi ))\right) \times $$ $$P_{\ell }\left(\frac{\sin (\theta ) ((K+1) \cos (\phi )+(1-K) \sin (\phi ))}{2 \sqrt{K^2+2 \mu K+1}}\right)d\phi d\theta$$ where $P_\ell$ are Legendre Polynomials. For $\ell$ larger than say 8, _Mathematica_ takes forever and runs out of memory. I have found out a method to circumvent the memory problem (see attempt below) but it still takes very long time to carry out the integration for $\ell>10$. **Question** Is there a way to be smart about this class of integral? Another approach to the one below? **Attempt** I have defined the integrant as               integ[ℓ_] :=       LegendreP[ℓ, (Cos[p] - Sin[p]) Sin[t]/          2] LegendreP[ℓ, (Cos[p] + Sin[p]) Sin[t]/          2] LegendreP[ℓ, ((1 + K) Cos[p] + (1 - K) Sin[p]) Sin[            t]/2/Sqrt[1 + 2 K μ + K^2]] Sin[t]      And the following integration rule:               r1 = {Exp[ Complex[0, b_] t +  p Complex[0, c_] ] ->         Integrate[Exp[ I b  t + I c p], {t, 0, Pi}, {a, 0, 2 Pi}],       Exp[ Complex[0, b_] t ] ->         Integrate[Exp[ I b  t], {t, 0, Pi}, {a, 0, 2 Pi}],       Exp[   p Complex[0, c_] ] ->         Integrate[Exp[ I c p], {t, 0, Pi}, {a, 0, 2 Pi}]}      so that I expand my integrant into sines and cosines into complex exponentials, and carry out the integration via substitution:                  integ[2] // TrigToExp // Expand //             Collect[#, Exp[_]] & // (# /. r1) & // Apart // Simplify           (*-((Pi*(43*K^2 + 84*K*μ + 43))/       (560*(K^2 + 2*K*μ + 1))) *)      A simple timing               Table[{i, integ[i] // TrigToExp // Expand //                       Collect[#, Exp[_]] & // (# /. r1) & // Apart //         Simplify;//Timing}, {i, 2, 6,2}]      suggest a $n^{4.5}$ scaling.


Replace elements in list not matching elements of another list at the same position

I would like to compare two arrays:               m = {a,b,c,d,d,f};     n = {b,b,a,d,d,e};      and get:               {0,b,0,d,d,0}      I have tried all kinds of things, like:               m = {a,b,c,d,d,f};     n = {b,b,a,d,d,e};     Transpose[{m, n}];     If[{x_ == y_} :> x, 0]      but clearly, I have no idea what I am doing! I am (obviously) very new to _Mathematica_ , and would greatly appreciate any help.


How to copy/paste an OverHat symbol into Microsoft Word 2010 properly?

I have problem with output traditional form of sign above the constant. When I copy/paste in word it is far away up. Is there solution for this?                BB /: MakeBoxes[BB[n_], TraditionalForm] :=       RowBox[{SubscriptBox["\!\(\*      StyleBox[OverscriptBox[      StyleBox[\"A\",\nFontFamily->\"Times New Roman\",\n\      FontWeight->\"Plain\",\nFontSlant->\"Italic\"], \"^\"],\nFontFamily\      ->\"Times New Roman\",\nFontWeight->\"Plain\",\nFontSlant->\"Italic\"\       ]\)", RowBox[{Sequence @@         Riffle[Table["\!\(\*SubscriptBox[\(c\), \(1\)]\)", {1}], 2]}]]}]          BB[1] // TraditionalForm     BB[2] // TraditionalForm


Showing a forest with root of the trees on the top

I have a Graph object that contains a forest with directed trees. I want to draw the forest such that the root of the trees are on the top and the leaves are on the bottom. If I use the following line of code:               Graph[{1, 2, 3, 4, 5, 6, 7}, {1 \[DirectedEdge] 2,        2 \[DirectedEdge] 3, 4 \[DirectedEdge] 6, 5 \[DirectedEdge] 6,        7 \[DirectedEdge] 4}, VertexLabels -> "Name",       GraphLayout -> "LayeredDrawing"]      I get this image: ![forest](http://i.stack.imgur.com/XSARB.png) Everything looks fine except the root (#3) is not on top. How can I resolve the issue?


Working of Date[]

`Date[]` returns the current date of local system, `Date[1]` returns {2012, 11, 15, 17, 41, 0.3161629}, `Date[2]` returns {2012, 11, 15, 18, 41, 0.3161629}, and `Date[3]` returns {2012, 11, 15, 18, 41, 0.3161629} and so on and why? Also, I tried this code                   a = DateList[] (*line 1*)         a = a + {0, 0, 0, 1, 0, 0} (*Line 2*)      After executing Line 2 for a few more times I get {2012, 11, 15, 25, 41, 0.3161629}. How can I fix this as I want to use increment time by 1 hour or 30 min in a `For` loop


Diagonalization in parallel

I would like to diagonalize one unitary non-sparse matrix of size 12870 with complex number entries (not symbols, this is really a numerical problem). Is is possible to make eigensystem run in parallel - I have access to a HPC cluster with many kernels - so that the diagonalization runs as fast as possible?


Binarize turning image completely black?

Running Binarize (or EdgeDetect) on a filled black and white image is resulting in an all black image. The image has the following color distribution (with most images points falling in either a zero or one bucket)               image = Import["http://imgur.com/HhsMeDc.png"] ;     ImageLevels[ image, 10 ]     ...     {{{0., 640000}, {0.1, 0}, {0.2, 0}, {0.3, 0}, {0.4, 0}, {0.5,        0}, {0.6, 0}, {0.7, 0}, {0.8, 0}, {0.9, 0}},      {{0., 640000}, {0.1,        0}, {0.2, 0}, {0.3, 0}, {0.4, 0}, {0.5, 0}, {0.6, 0}, {0.7,        0}, {0.8, 0}, {0.9, 0}},      {{0., 640000}, {0.1, 0}, {0.2, 0}, {0.3,        0}, {0.4, 0}, {0.5, 0}, {0.6, 0}, {0.7, 0}, {0.8, 0}, {0.9,        0}},      {{0., 370003}, {0.1, 809}, {0.2, 605}, {0.3, 555}, {0.4,        612}, {0.5, 550}, {0.6, 580}, {0.7, 616}, {0.8, 764}, {0.9,        264906}}}      ![dragon](http://i.stack.imgur.com/Gwwvq.png) This binarize attempt:               b = Binarize[ image ]      ImageLevels[ b ]      produces an all black image, with the levels showing only zero values:                {{0, 640000}, {1, 0}}      I tried various thresholds, including the default and some explicit values (or 0.5, 0.9, 0.1, ...), but still get the all zero levels?


Understanding CDF

**Update** Since more and more issues are revealed as I venture deeper into the world of CDF, I decided to make this thread more general and hopefully more useful. I know posted my findings as an answer, but please feel free to edit this post or my answer below if you know something useful. **Questions** I have a quite large project that I want to deploy to the web. I expect users to only have the browser plugin or _Mathematica_ Player, but not Player Pro.   1. Can I use `DynamicModule` in a CDF that is to be viewed by the plugin or the _Mathematica_ Player? Does it always have to be a `Manipulate` in focus in the dynamic interface that is generated?   2. Can I deploy the dynamic output somehow without piling all the used functions and data into the `DynamicModule`-s body or `Initialization` option? `Manipulate` has the option `SaveDefinitions` but `DynamicModule` does not. Does `SaveDefinitions` work with packaged functions as well?   3. What exactly happens when only the dynamic output is selected and deployed (and not the whole document) to CDF via the wizard? What is the difference between deploying only the output or deploying the whole notebook, but with all the code cells being hidden? What is the technical difference between demonstrations and CDFs?   4. Is there any difference (and if so, what) between _Mathematica_ Player, Player Pro and the browser plugin?   5. What are the differences between CDFs intended for _Mathematica_ Player or Player pro, i.e. free CDFs and non-free CDFs (see discussion here)?   6. How to overcome security issues (discussed here and here): when the deployed CDF shows up as a gray box because dynamic updating is disabled for security reasons?


How to get .cdf format to work with functions?

I would like to create simple functions and then pass them into a Manipulate function that can be used in a .cdf file. eg               f[x_] := x^2 + 4;     Manipulate[                Plot[f[x], {x, -c, c}]                , {c, 1, 5}]      works fine as a notebook but crashes as a .cdf


Any hidden keyboard shortcut for RightTeeArrow?

The Basic Math Assistant palette does not show a keyboard shortcut for RightTeeArrow. Is there some hidden key combination that results in the output? (Just hoping to be able to avoid having to reach for the mouse and move over.)


How to find the vertices of a regular tetrahedron? a dodecahedron?

My question is: how to find the coordinates of the vertices of regular tetrahedron and dodecahedron? I tried to find the coordinates of the vertices of a regular tetrahedron as the solutions of a certain polynomial system in $8$ variables, notating the vertices of a tetrahedron $S(0,0,1)$, $A(0,yA,zA)$, $B(xB,yB,zB)$, and $C(xC,yC,zC)$:               Reduce[     yA^2 + zA^2 == 1 &&     xB^2 + yB^2 + zB^2 == 1 &&      xC^2 + yC^2 + zC^2 == 1 &&      yA^2 + (zA - 1)^2 == xB^2 + yB^2 + (zB - 1)^2 &&      yA^2 + (zA - 1)^2 == xC^2 + yC^2 + (zC - 1)^2 &&      xB^2 + (yB - yA)^2 + (zB - zA)^2 ==                      xC^2 + (yC - yA)^2 + (zC - zA)^2 &&      xB^2 + (yB - yA)^2 + (zB - zA)^2 ==                      (xC - xB)^2 + (yC -yB)^2 + (zC - zB)^2 &&      xB^2 + (yB - yA)^2 + (zB - zA)^2 ==                       yA^2 + (zA - 1)^2,             {xB, xC, yA, yB, yC, zA, zB, zC}, Reals]      However, that code is spinning for hours without any output. A new idea is required. P.S. 12.12.13. The answer done with Maple can be seen at http://mapleprimes.com/questions/200438-Around-Plato-And-Kepler-Again. Because nothing but trigonometry is used, I am pretty sure all that is possible in _Mathematica_.


Linearity of a function in Mathematica

I have a function which has something like `myFunc[q,a state[c,d]]` `a` could be anything, and I want to tell _Mathematica_ that this part of the function is linear, so that the coefficient of `state[c,d]` can be taken outside so that it achieves this result `a myFunc[q,state[c,d]]` Can this be done? Why is this important? I'm doing simulations on quantum mechanics, and operators have to be linear with respect to numbers, and this is important to make calculations easier.


Hiding the Code in .CDF File

I downloaded the source code of a demonstration and modified it. Then saved it as a CDF file. When I re-opened this file (in _Mathematica_ or _CDF Player_ ), all of the code can be seen. How can I hide the code so that only the manipulation panel be shown? I want it to be seen just as the demonstrations on the website demonstration.wolfram.com. I searched this site but found no solution to my problem. By the way, I use _Mathematica_ 8.0.


How to solve a stiff nonlinear second-order ode?

I want to solve a nonlinear second order ODE as an initial value problem (IVP). Unfortunately, for certain values of first derivative at starting point I get a stiff-problem. I tried to overtake this issue looking at _Mathematica_ help, but those advices don't work in my case. My equation is the following: $$ \gamma(\lambda) \lambda_{zz} + \beta(\lambda) \lambda_z^2 + \tau(\lambda) = T_M $$ where $$ \varphi(\lambda) = a_0 + a_1 \lambda^2 + a_2 \lambda^2 + a_3 \lambda^3 + a_4 \lambda^4 \\\ \tau(\lambda) = \varphi'(\lambda) \\\ \gamma(\lambda) = - \frac{h_0^2}{12} \frac{\tau(\lambda)}{\lambda^5} \\\ \beta(\lambda)=\frac{1}{2} \gamma'(\lambda) $$               H0 = 1;     par = {            a0 -> 2.0377638272727268,            a1 ->  -7.105521894545453,            a2 -> 9.234000147272726,            a3 -> -5.302489919999999,            a4 -> 1.136247839999999           };          φ[λ_] := a0 + a1 λ + a2 λ^2 + a3 λ^3 + a4 λ^4 /. par;     τ[λ_] := φ'[λ];     γ[λ_] := -(H0^2/12) τ[λ]/λ^5;     β[λ_] := 1/2 γ'[λ];          TM = 0.0059225557575715015;          Eq = γ[λ[x]] D[λ[x], {x,2}] + β[λ[x]] D[λ[x],x]^2 + τ[λ[x]];          xL = 0;     xR = 1;          ym = 1.1666666666666892;     yp = 1;          SYSf = Flatten[NDSolve[{                     Eq == TM,                     λ[0] == ym,                     λ'[0] == yp                    }, λ[x], {x, xL, xR}]                   ]      $ym$ is the value of function in $x = 0$, and $yp$ the first derivative. If I set $yp = 2$ I get the following error: > NDSolve::ndsz: At x == -0.311892, step size is effectively zero; singularity > or stiff system suspected. >> NDSolve::ndsz: At x == 0.37944200653091864`, > step size is effectively zero; singularity or stiff system suspected. >> So I tried some advices written in the help:               Needs["DifferentialEquations`NDSolveProblems`"];     Needs["DifferentialEquations`NDSolveUtilities`"];          SYSf2 = Flatten[NDSolve[            {Eq == TM,             λ[0] == ym,             λ'[0] == yp},             λ[x], {x, xL, xR}, Method -> "StiffnessSwitching"]            ]      or               SYSf3 = Flatten[NDSolve[          {Eq == TM,           λ[0] == ym,           λ'[0] == yp},           λ[x], {x, xL, xR},            Method -> {"StiffnessSwitching", Method -> {"ExplicitRungeKutta", Automatic}}]          ]      but with no success. What can I do in order to set $yp \ge 2$? Petrus **\--- EDIT ---** I changed function definitions using SetDelay operator (:=).


Symbolic linear algebra

I would like to know how I can ask _Mathematica_ to expand (and simplify) such an expression : $$ (\alpha A + \beta B)^\top (\alpha A + \beta B) $$ where $\alpha,\beta$ are two real numbers and $A,B$ are vectors in $\mathbb{R}^{n}$. $A^\top$ denotes the transpose of $A$. I assume I must tell _Mathematica_ that $A$ and $B$ are vectors. Here is what I have tried :               $Assumptions = (A | B) [Element] Vectors[n];         $Assumptions = (a | b) [Element] Reals;     TensorExpand[ Transpose[a*A + b*B].(a*A + b*B) ]      and the output is :               a A.Transpose[a A + b B, {2, 1}] + b B.Transpose[a A + b B, {2, 1}]      Which is not what I expected since I would like the output to be : $$ \alpha^{2} A^\top A + 2 \alpha \beta A^\top B + \beta^{2} B^\top B $$


Performing matrix multiplications with a list

I have a question in regards to `PseudoInverse`. I have $A$, an $n\times 2$ matrix, and when I want to compute $(A^T A)^{-1}A$, by using `PseudoInverse`, _Mathematica_ is able to give me an answer for this. However If I want to compute $(A^T A)^{-1}$, I am not able to. Here are the data:               goog = FinancialData["goog", {2012}]; yahoo = FinancialData["yhoo", {2012}];     A = Transpose[{yahoo[[1 ;;, 2]], constant}] (*Where constant is a list of value 1(Intercept)*)     kik = PseudoInverse[A]\[Transpose]*goog[[1 ;;, 2]]     Total[kik[[1 ;;, 1]]] (*gives me the coefficient*)     and Total[kik[[1 ;;, 2]]] (*gives me the intercept.*)      Now I often get mathematical equations which is written as $c^Tc$, lets say that $c$ is a vector list, but _Mathematica_ always gives an error. where c=RandomReal[100, 100] And if we look at the data given here as x, if I want to compute $(xx^T)^{-1}$, how is this done? I am struggling with the understanding of matrices and I therefore need a good understanding of how _Mathematica_ deals with these situations, I am also very sure that this would benefit other _Mathematica_ users, based on the fact that the other students taking the same class as I, are struggling with exactly the same thing in _Mathematica_.


Understanding the computation of IntensityCentroid?

If I have an image `img`, and I ask `ComponentMeasurements` to return `"IntensityValues"` for the image:               m=MorphologicalComponents[Binarize[img]];     ivalues=ComponentMeasurements[{m,img},"IntensityData"];      How can I replicate the output of `ComponentMeasurements[{m,img},"IntensityCentroid"]`? The challenge I'm having is understanding how to interpret a calculated intensity centroid from `"IntensityValues"` in the context of larger image with the overlayed morphological component? Is it flipped or rotated? It would be fantastic to see an example going from the raw `"IntensityValues"` data to the output of `ComponentMeasurements[{m,img},"IntensityCentroid"]` for the same morphological component.


Mathematica with a Touchpad

I'm trying to make it so that you do not need to rely on keyboard presses to manipulate a 3D graphic. I've done some searching, but I can't find a way to make it so that Mathematica will recognize something else as equivalent to a Shift or Ctrl press. Anyone have any ideas on how I could make a 3D Graphic fairly interactive with only a touchpad? (Pinch-to-Zoom, Two-Finger Panning, etc.)? Thanks in advance. By the way, I'm running a Logitech T651 on a Mac (I am using the Mac- compatible touchpad). The Pinch feature on the touchpad currently causes all of Mathematica to be magnified, including any interfaces or lines of code. Not sure if this helps.


How to combine a set of Plots, including self-drawn Inset/Lines/Circles?

I have a set of 9 plots which should be combined into one plot. Each of these plots contains a `ListContourPlot`, some circles, lines and an `Inset` containing again a circle, some arrows and some text: ![enter image description here](http://i.stack.imgur.com/Ptfsx.png) I already tried to use Levelscheme mentioned in this Question: http://stackoverflow.com/questions/5818888/how-to-make-a-grid-of-plots-with-a- single-pair-of-framelabels In my first attempts with a dummy `ContourPlot` function it worked pretty fine, but as I tried to use it with my plots it got totally confused: ![enter image description here](http://i.stack.imgur.com/kEchx.png) I think the custom drawn lines/circles are the problem. I used pretty much the same code shown in the thread above:               Get["LevelScheme`"]          Figure[{Multipanel[{{0, 1}, {0, 1}}, {3, 3},     (*XFrameLabels->Text["x [mm]"],     YFrameLabels->Text["y [mm]"],*)     BufferB -> 3,     BufferL -> 3,     TickFontSize -> 18,     FontSize -> 18,     FontFamily -> "FrontPage",     XGapSizes -> 0,(*Abstände zwischen Plots*)     YGapSizes -> 0,     ExtendRange -> 0.05,(*erhöht Raum innerhalb des Frames*)     PanelLetterCorner -> {0.98, 1},     ShowTickLabelsExterior -> {True, True, False, False},     ShowPanelLetter -> False     ],          FigurePanel[{1, 1}, PlotRange -> {{-range, range}, {-range, range}}],     RawGraphics[fullAngle[[1, 1]]],     FigurePanel[{1, 2}, PlotRange -> {{-range, range}, {-range, range}}],     RawGraphics[fullAngle[[1, 2]]],     FigurePanel[{1, 3}, PlotRange -> {{-range, range}, {-range, range}}],     RawGraphics[fullAngle[[1, 3]]],     FigurePanel[{2, 1},      PlotRange -> {{-range, range}, {-range, range}}, LabL -> Text["y [mm]"]],     RawGraphics[fullAngle[[2, 1]]],     FigurePanel[{2, 2}, PlotRange -> {{-range, range}, {-range, range}}],     RawGraphics[fullAngle[[2, 2]]],     FigurePanel[{2, 3}, PlotRange -> {{-range, range}, {-range, range}}],     RawGraphics[fullAngle[[2, 3]]],     FigurePanel[{3, 1}, PlotRange -> {{-range, range}, {-range, range}}],     RawGraphics[fullAngle[[3, 1]]],     FigurePanel[{3, 2},       PlotRange -> {{-range, range}, {-range, range}}, LabB -> Text["x [mm]"]],     RawGraphics[fullAngle[[3, 2]]],     FigurePanel[{3, 3}, PlotRange -> {{-range, range}, {-range, range}}],     RawGraphics[fullAngle[[3, 3]]]          },     PlotRange -> {{-0.08, 1.01}, {-0.15, 1.01}},     ImageSize -> 600     ]      In a second attempt I found this thread: Do I have to code each case of this Grid full of plots separately? Also the posted function in Jens' answer works mostly pretty well. The only point is, that it also gets confused by the `Inset`-s in my graphs; the result looks like: ![enter image description here](http://i.stack.imgur.com/rzhaQ.png) So my questions are: Is it possible to use Levelscheme with my existing graphs, without modifying/redrawing them? Or is it possible to alter Jens' algorithm to make it fit to my insets? Or: any other suggestion, that lets me create the desired set of graphs. EDIT 1: you can easily reproduce the graph with the following code:                AngleInset[\[Alpha]_] := Show[Graphics[{Thick, Circle[]}],       Graphics[{ { Black, Thick, Arrowheads[Large],        Arrow[{{0, 0}, {1.1, 0}}]}, {Black, Thick, Arrowheads[Large],        Arrow[{{0, 0}, {0, 1.1}}] }}],      Graphics[{Thick, Circle[{0, 0}, 0.5, {0, (-\[Alpha] Degree)}]}],      Graphics[{Red, Thick, Arrowheads[Large],       Arrow[{{0, 0}, {Cos[-\[Alpha] Degree], Sin[-\[Alpha] Degree]}}]}],      Graphics[      Style[Text[       ToString[-\[Alpha] ] <> "\[Degree]", {0, -0.5}, {0, 0} ], 24]],      Frame -> True,      FrameTicks -> False      ];          ContourPlot[Sin[x]²+Cos[y]^2, {x, 0, 2 Pi}, {y,0,2Pi},     Epilog ->      Inset[AngleInset[90], {Right, Top}, {Right, Top}, 6,      Background -> White]]


NDSolve: ProcessEquations and Reinitialize with Piecewise functions

I am having trouble with using NDSolve`Reinitialize when the system consists of a pieceise function. If we define the ODE system                simplesys = {r'[t] ==      Piecewise[{{1, 0 <= t <= 10}, {0, 10 <= t <= 20}}, 0], r[0] == 0};      and process the equations with               state = First@NDSolve`ProcessEquations[simplesys, r, t]      this works perfectly fine. However, when I try to reinitilize the ODE system with a new initial condition               newstate = NDSolve`Reinitialize[state, {r[0] == 2}]      this fails with the message               NDSolve`Reinitialize::ntcs: Cannot solve constraint equations for initial conditions.      This is due to the piecewise function in the system, I haven't got this problem for other types of systems, it only occurs when I have piecewise function. How can I solve this issue?


More efficient way of generating list of occurrence counts?

Given a list, e.g., `target = {a, b, c, b, c, d, c, d, e, f, a, h, g}`, I want to generate a list containing the occurrence count of the corresponding element of the target list, e.g., `{1, 1, 1, 2, 2, 1, 3, 2, 1, 1, 2, 1, 1}` for the example target. Target elements can be pretty much anything: atoms, sublists, etc. I'm using `result = Module[{c}, c[_] = 0; ++c[#] & /@ #] &[target]` which works fine, but wonder if the wizards have a more efficient way. Update: Came up with this while 'cigar thinking':               result = Module[{ordarg, ord},          ordarg[[ord]] =            Flatten[Range /@ (Tally[ordarg = #[[ord = Ordering[#]]]][[All, 2]])];          ordarg] &[target];      On numeric/symbol/etc. items, this clobbers my original method by orders of magnitude with large lists. It is also 2-3+ times faster even then the most excellent compiled example provided below by L.S. Interestingly, my original method is faster than this or the compiled version for string/character data. (L.S./M.W. et al, perhaps you can illuminate this?) This is plenty fast for my needs, though I'm still of course interested in the real masters' ideas.


Map and Scan ignore HoldFirst

I am trying to write a simple function that takes a list of data and outputs it to a file. I'd like the name of the file to be the same as the variable that holds the list. It seems that giving a function the attribute HoldFirst solves this problem. For example:               a = 1;          ClearAll[printName];     SetAttributes[printName, HoldFirst];     printName[var_] := ToString@Unevaluated@var      When called, this returns               In: printName@a     Out: "a"      as expected. However, things get murkier when I try to Map this function over a list. For example:               In: a = 1;         b = 2;         c = 3;              l1 = {a, b, c};              printName /@ l1          Out: {"1", "2", "3"}      For some reason Map seems to ignore the attribute HoldFirst. Is there a reason for this? The closest I see in the documentation to an answer is this: "Map always effectively constructs a complete new expression and then evaluates it." But, I don't think this is the problem, because I see similar behaviour with Scan. Any insight would be appreciated. Thanks.


Correct fourier scaling and high-resolution frequency identification

I have a dataset of amplitude versus time $(t,A(t))$ and I need to extract the dominant frequency and amplitude, and also get the amplitude at one other specific frequency. My data looks like this:               data = {{-9.75, 13.76}, {-9.5, 14.352}, {-9.25, 15.66}, {-9.,  16.506}, {-8.75, 17.768}, {-8.5, 17.218}, {-8.25, 15.794}, {-8.,  13.18}, {-7.75, 11.58}, {-7.5, 10.524}, {-7.25, 8.428}, {-7., 6.544}, {-6.75, 4.408}, {-6.5, 2.586}, {-6.25,   0.274}, {-6., -2.194}, {-5.75, -4.982}, {-5.5, -6.224}, {-5.25, -9.698}, {-5., -12.22}, {-4.75, -13.986}, {-4.5, -15.372}, {-4.25, -15.1}, {-4., -15.47}, {-3.75, -14.088}, {-3.5, -13.388}, {-3.25, -12.424}, {-3., -12.506}, {-2.75, -11.83}, {-2.5, -9.886}, {-2.25, -8.066}, {-2., -7.434}, {-1.75, -5.23}, {-1.5, -2.418}, {-1.25,   0.252}, {-1., 2.726}, {-0.75, 5.184}, {-0.5, 7.668}, {-0.25,  8.684}, {0., 9.7}, {0.25, 11.866}, {0.5, 13.534}, {0.75, 15.05}, {1., 17.512}, {1.25, 17.99}, {1.5, 16.84}, {1.75,  15.154}, {2., 12.682}, {2.25, 10.358}, {2.5, 9.314}, {2.75, 9.07}, {3., 7.866}, {3.25, 5.244}, {3.5, 2.27}, {3.75, -0.564}, {4., -2.012}, {4.25, -3.078}, {4.5, -5.484},  {4.75, -8.834}, {5., -11.234}, {5.25, -13.162}, {5.5, -15.11}, {5.75,  -16.684}, {6., -16.588}, {6.25, -14.99}, {6.5, -14.336}, {6.75, -12.956}, {7., -12.44}, {7.25, -11.72}, {7.5, -10.854}, {7.75, -8.384}, {8., -6.082}, {8.25, -3.848}, {8.5, -1.772}, {8.75, 0.552}, {9., 3.186}, {9.25, 5.154}, {9.5, 6.976}, {9.75, 8.602}, {10., 9.042}}      And I would like to define a function that takes in account the $x$ scaling for proper scaling of the spectrum. The scaling has been discussed in other questions. But there are some issued that are stopping me. What I have is (mainly copied from here) :               xyF[d_] := Block[{n, t, y, dt, ft, fy},       n = Length[d];       t = d[[All, 1]];       y = d[[All, 2]];       dt = Tally[Differences[t]][[1, 1]];       fy = Abs@Fourier[y];       ft = RotateRight[Range[-n/2, n/2 - 1]/(n dt), n/2];       Sort[Transpose[{ft, fy}], (#1[[1]] < #2[[1]]) &]       ]      My questions are:   * What is the scaling if the number of points `n` is odd instead of even?   * How do I obtain a high-resolution estimation of the dominant frequency?   * How do I get the intensity of a frequency not explicitly given? (Other than interpolating, given that close to the peak that interpolation may be poor.)


Using Mathematica to help obtain correct analytic formula for logarithm integration

I need to program into my Mathematica code the analytic form for the result of the integral: $$I(a,b)=\int ^1 _0 dx \frac{\ln(x-a)}{x-b}$$ that is valid for all complex $a$ and $b$ (but $\text{Im } b\neq0)$. Following the steps that I posted in this math SE question, I arrived at $$\begin{aligned}I(a,b)&=\text{Li}_2\Big(\frac{-1+a}{a-b}\Big)-\text{Li}_2\Big(\frac{a}{a-b}\Big)\\\ &\qquad+\ln\Big(1+\frac{1-a}{a-b}\Big)\ln(1-a)-\ln\Big(1-\frac{a}{a-b}\Big)\ln(-a)\,.\end{aligned}$$ But this is only valid for a subset of $a$ and $b$ since I haven't paid attention to how the logarithmic cut of the integrand may be crossed by the integration contour. Indeed comparing the numerically integrated result with the analytic one I derived, there is a **wedge** in the complex $a$ plane (for fixed $b$) for which my formula is wrong:               (*Numerical integration and analytic formula*)     fnum[a_, b_] /; Im[a] != 0 := NIntegrate[Log[x - a]/(x - b), {x, 0, 1}];          fanal[a_, b_] = PolyLog[2, (-1 + a)/(a - b)] - PolyLog[2, a/(a - b)] +         Log[1 + (1 - a)/(a - b)] Log[1 - a] - Log[1 - a/(a - b)] Log[-a];      Now compare:               GraphicsRow[      {Plot3D[Im[fnum[x + I y, .4 + 2 I]], {x, -5, 5}, {y, -5, 5}],       Plot3D[Im[fanal[x + I y, .4 + 2 I]], {x, -5, 5}, {y, -5, 5}]}     ]      ![enter image description here](http://i.stack.imgur.com/5nuau.png) I have checked that the difference between `fnum` and `fanal` is indeed zero except inside the **wedge**. I'm desperately trying to get the analytic formula correct for all $a$ and $b$, but as evidenced by the math SE question I posted, my mathematical skills are simply not strong enough. I know that I must add/subtract $i\pi$ from the logarithms to select the right branch. But I don't know exactly what the conditions on $a$ and $b$ are. Is it possible for _Mathematica_ to help me out (basically picking up slack) in obtaining the more general analytic formula that is valid for _all_ complex values of $a$ and $b$, including inside the **wedge**?


Computing a sum

I'm trying to make Mathematica compute this sum:               Sum[(-1)^k (n - k)^2 Binomial[2 n, k], {k, 0, n}]      As is, I get an awful formula:               Sum[(-1)^k (n - k)^2 Binomial[2 n, k], {k, 0, n}] // FullSimplify      ![enter image description here](http://i.stack.imgur.com/mdKPV.png) Using Maxima, I get the (almost correct) result `0`, with `nusum((-1)^k*(n-k)^2*binomial(2*n,k),k,0,n);`. But for `n=1`, the result is `1`, so Maxima is a bit too aggressive here: ![enter image description here](http://i.stack.imgur.com/Ae1zR.png) So I try to add assumptions to Mathematica:               Sum[(-1)^k (n - k)^2 Binomial[2 n, k], {k, 0, n},        Assumptions -> Element[n, Integers] && n > 1] // FullSimplify     Refine[%, Element[n, Integers] && n > 1]      ![enter image description here](http://i.stack.imgur.com/xvqJ1.png) It's much better, but there is an obvious simplification, and I don't know how to make Mathematica "see" it. An hypergeometric series with a negative integer parameter is a polynomial, and here it's especially simple. `FunctionExpand` does not work either. However, we have really a `Hypergeometric2F1`, and if I write it explicitly, the simplification is possible:               -2 n Hypergeometric2F1[2, 1 - 2 n, 1, 1]     Refine[%, Element[n, Integers] && n > 1]      ![enter image description here](http://i.stack.imgur.com/P6T1U.png) Is there a way to make this a bit more automatic?


PDE problem with initial and boundary conditions

I'm new to mathematica and I don't know what I do wrong, I have written the following PDE problem, with both initial and boundary (four in total)               eq = D[u[x, t], t, t] + D[u[x, t], t] - 2*D[u[x, t], x, x] == 0     bc = {u[0, t] == 0, u[2*Pi, t] == 0, u[x, 0] == 0, Derivative[0, 1][u][x, 0] == sin (2*x)}          DSolve[{eq, bc}, u[x,t], {t, x}]      I need it to solve the PDE, but it doesn't even try to make a solution... what to do. I hope you can help me


Evaluation of a Variable Coefficient PDE

I am trying to render the solution of the following partial differential equation: $$ u = u(x,y)~;\quad \frac1{x^{2/3}}\partial_xu \+ x^3\partial_yu \+ \partial_y^2u \+ \partial_x^3u = 0 $$ However, the kernel seems to not produce anything. I checked documentation for different ways of inputting in the equation, but nothing helps. I even tried the sample problems directly from the documentation and those still had no explicit solution. I also quit the local kernel and repeated the process twice. I used something of the following:               eqn2 = D[u[x, y], {x, 3}] + D[u[x, y], {y, 2}] + x^3 D[u[x, y], y] +      1/x^(2/3) D[u[x, y], {x, 1}] == 0;          DSolve[eqn2, u, {x, y}]      Any ideas of what is going on?


Transform Piecewise[] into sum of indicators

I'm interested in transforming a piecewise defined function into a sum of indicator functions, ultimately with the aim to be better able to integrate them. As an example I would like to transform the function               f = Piecewise[{{x, 3*x > y && x < 2*y}, {y, 2*x > y && x < 3*y}}, 0]      into               x Boole[3 x > y && x < 2 y] + y Boole[x >= 2 y && x < 3 y].      For this specific example, this could be achieved by               f[[1,1,1]]Boole[f[[1,1,2]]] + f[[1,2,1]]Boole[f[[1,2,2]] && !f[[1,1,2]]]      but I don't know how to efficiently generalize this to functions with more than two cases, in particular how to ensure that the term corresponding to the $n$th case contains the negated conditions of the first $n-1$ cases. In a second step, assuming that the conditions of the piecewise function are linear inequalities, I would like to decompose each Boole[] into a sum of Boole[]'s of disjoint intervals for, say, the variable $x$. In my example above this would mean               Boole[3 x > y && x < 2 y] == Boole[y/3 < x < y/2]     Boole[x >= 2 y && x < 3 y] == Boole[2y < x < 3y]      This is maybe a trivial example, but in more complex situations one will have to deal with more than one disjoint interval. In non-Mathematica notation I'd like a decomposition of the form $$ f(x) = \sum_i f_i(x) \sum_j\mathbf{1}_{\left\\{x_{i,j}^{\min}<x<x_{i,j}^\max\right\\}}(x). $$ where the $f_i$ are given by `f[[1,All,1]]`.


Long waiting time for computing a summation

It takes a long time to compute the summation below, and I'd like to know if there are alternative ways   to compute things faster. When replacing $15$ by $\infty$, then I should get $3^{1/3}$. I need Mathematica solution   not mathematical solutions (since here I can handle things on my own).               Clear[b, k]     b[0] := 1;     b[k_] := b[k - 1] + 1/(b[k - 1]^2 + b[k - 1] + 1)     N[1/(15)^(1/3) Sum[1/(b[k]^2 + b[k] + 1), {k, 0, 15}]]


How would I improve this Karaoke machine code?

I was looking at a large collection of Import/Export user suggestions the other day and it dawned on me that we finally have MIDI import in Mathematica 9, which is rather interesting since MIDI supports karaoke text events, which can be run in Mathematica with scheduled tasks. So I wrote a simple code for a Karaoke machine function, which plays a given MIDI karaoke file and highlights the text that needs to be sung at the same time.               $DisplayEvents = {      {0.0, {Red, FontSize -> 18}},       {0.5, {Orange, FontSize -> 18}},       {1.0, {Gray, FontSize -> 18}}};          TextEvents[file_] := Module[{events},      events = Cases[Import[file, "Metadata"], {time_, "TextEvent" -> text_}, 2];      events = Select[events, Not[StringMatchQ[#[[2, 2]], "\\@*"]] &];      Map[{#[[1]], StringReplace[#[[2, 2]], {"\\" -> "\n\n", "/" -> "\n"}]} &,        events]];          ScheduleTextEvents[events_] := Module[{},      Outer[With[{e = #1, d = #2},       RunScheduledTask[        Unevaluated[displayEvent[e] = Last[d]], {Max[0.0, First[e] + First[d]]}]] &,       events, $DisplayEvents, 1]]          Cleanup[] := { Cell[MakeBoxes@Row[{      Button["Stop Music", Sound`StopMIDI[]; RemoveScheduledTask /@ ScheduledTasks[]],       Button["Close Notebook", NotebookClose[EvaluationNotebook[]]]}]]}          KaraokeMachine[file_] := Module[{lyrics, song, events},      song = Import[file];      events = TextEvents[file];      Map[(displayEvent[#] = {White, FontSize -> 18}) &, events];      CreateDocument[ ExpressionCell[       With[{t = events},        Dynamic[Row[With[{x = #}, Style[x[[2]], displayEvent[x]]] & /@ t]]],        "Output", ShowCellBracket -> False], Background -> Black,        WindowElements -> {"VerticalScrollBar"},        Deployed -> True, DockedCells->Cleanup[]];      EmitSound[song];      ScheduleTextEvents[events];     ]      Which can then be called by giving it a karaoke file (for example this song by Frank Sinatra):               KaraokeMachine[ "myway.kar"]      My question mostly revolves about ideas on how I can improve on this (code improvements as well as suggestions on how to implement features, like fading in/out text). (Note: Mathematica uses the Jlink/Java MIDI implementation on MacOSX, which means that you may run into this issue on newer versions of MacOSX. I haven't been able to find a solution for this yet).


How can I type-check the arguments of a Mathematica function?

(For educational purposes) I defined the following functions: Translation (in $\mathbb{R}^2$):               trM[vec_] := {{1, 0, vec[[1]]}, {0, 1, vec[[2]]}, {0, 0, 1}}      Rotation (in $\mathbb{R}^2$):               rotM[angle_] := {{Cos[angle], -Sin[angle], 0}, {Sin[angle], Cos[angle], 0}, {0, 0, 1}}      Rotation around a point (in $\mathbb{R}^2$):               rotM[pt_, angle_] := trM[pt].rotM[angle].trM[-pt]      So far so good, now I want a function:               rotM[angle_, n_] :=        {{Cos[n angle], -Sin[n angle], 0}, {Sin[n angle], Cos[n angle], 0}, {0, 0, 1}}      Now                rotM[angle_, n_]       and               rotM[pt_, angle_]       share — in _Mathematica_ — the same signature, which breaks the polymorphism I intended to use, which then leads to the following question. **How can I type-check the arguments of a _Mathematica_ function to enforce polymorphism?**


Replicability of RandomVariate within a function?

I have a rather basic question but can't figure out a foolproof answer. In the following code, I build a function which returns the mean difference between successive elements of a vector created from `j` random variates from an exponential distribution:               fun2[j_] :=          Module[{x = RandomVariate[ExponentialDistribution[1/25], j]},          Mean[Table[Abs[x[[i + 1]] - x[[i]]], {i, Length[x] - 1}]]]      Will the use of the `x` call to `RandomVariate` create an immutable object, i.e. so that `x[[i + 1]]` and `x[[i]]` reference the same instance of the distribution? Thanks a lot for any help.


Parallelizing Numerical Integration in Mathematica

I have an ugly, six dimensional function that I need to integrate numerically. It works, but it currently take twelve hours to complete the calculation. Is there any good way to parallelize the calculation to run across multiple cores? The best I've managed to come up with is:               Sum[         ParallelTable[             NIntegrate[calc[a,b,c,d,e,f],                        {a,-1,1},                        {b,-1,1},                        {c,-1,1},                        {d,-1,1},                        {e,-1,1},                        {f,-1+i/4,-1+(i+1)/4}],         {i,0,7}]]      **EDIT:** The value for calc is given below:               calc[a,b,c,d,e,f] = (1.97531*10^15 (3. Q Cos[(3 Q)/20000] -           20000. Sin[(3 Q)/20000])^2)/(1.58025*10^24 + 6.32099*10^16 Q^2 +         Q^6 + (-1.58025*10^24 + 7.90123*10^15 Q^2 - 3.55556*10^8 Q^4) Cos[(          3 Q)/10000] + (-4.74074*10^20 Q - 2.96296*10^12 Q^3) Sin[(3 Q)/          10000])*         UnitStep[5/2 - a]^2 UnitStep[5/2 + a]^2 UnitStep[5 - b]^2 UnitStep[           5 + b]^2 UnitStep[5 - a - 1944 c] UnitStep[5 + a + 1944 c] UnitStep[           5 - b - 1944 d] UnitStep[5 + b + 1944 d] UnitStep[           40 + a - 1600 e] UnitStep[40 - a + 1600 e] UnitStep[           45/2 + b - 1600 f] UnitStep[45/2 - b + 1600 f] /. Q-> (8000000 \[Pi] Sin[               1/2 ArcCos[                 1/2 Sqrt[Cos[2 c] + Cos[2 d]] Sqrt[Cos[2 e] + Cos[2 f]] +                   Sin[c] Sin[e] + Sin[d] Sin[f]]])      There are two immediate things to note. First, there's a removable singularity at (c==e && d==f). I've also tried using a piecewise function to plug this discontinuity, but it doesn't seem to have a significant effect on the speed. One other thought that has come to mind is using the UnitSteps to directly find the range of integration. I hadn't done that before mostly out of laziness and the understanding that Mathematica automatically breaks up piecewise functions for integration, anyway.


How could we define a function recursively?

Let us first consider the constructon of the following simple iteration               Clear["Global`*"]     p[z_] := z^3 - 1;     beta = -Sign[p'[z]];     theIterationFunction = z - p[z]/(p'[z] + beta p[z]) // FullSimplify      which results in the following correct iteration function $$theIterationFunction=z+\frac{-1+z^3}{-3 z^2+\left(-1+z^3\right) \text{Sign}[z]^2}.$$ Now by choosing any value for $z$, the output would be simply given in Mathematica 8, _since the computation of $\text{Sign}[z]$ has been done automatically_. My problem is in a similar but more complicated iteration. Please consider the following               Clear["Global`*"]     p[z_] := z^3 - 1;     w = z + beta  p[z]; FD = (p[w] - p[z])/(w - z);     theIterationFunction2 = z - p[z]/FD // FullSimplify      which yeilds in $$theIterationFunction2=z-\frac{\text{beta} \left(-1+z^3\right)^2}{-z^3+\left(z+\text{beta} \left(-1+z^3\right)\right)^3}.$$ In fact, here $beta$, must be calculate by the formula $beta=\frac{-p[z]+p[z+\text{beta} p[z]]}{\text{beta} p[z]}$. That is, there is a self-defined formula for $beta$, which itself depends on $beta$. Thus, we must choose a starting value for $beta$, such as $beta=0.1$ at the beggining, but after that, each time theIterationFunction2 must calculate a new value based on its formula. For example, at the very beggining, we set $beta=0.1$ and $z=2.$, and the output will be a new value for $beta$ (NEEDLESS TO BE SHOWN) and my aimed value $y$. Now, if I give $y$, the last value of $beta$ which is saved in the memory must be used to produce a new value for $beta$ and my aimed new value $yy$. The process must be go on in this way. Hence, altogether I must define a function recursively with a pre-assumed starting value for $beta$, while I am un-able to do so! I will be thankful if anyone could help me to define such a function recursively.


Why do my results show small deviations from expected values?

Table[StringForm["p=`1`", i], {i, 0.05, 0.5, 0.05}]     (*         {p=0.05`, p=0.1`, p=0.15000000000000002`, p=0.2`, p=0.25`, p=0. 30000000000000004`,         p=0.35000000000000003`, p=0.4`, p=0.45`, p=0.5`}     *)      Why do the results show small deviations from the expected numbers `{..., 0.15, ..., 0.30, ...}`?


Optimizing repeated function calls

Easiest way to keep my library nice, is to naively call some functions many times with same parameters. Doing so prevents from zoo of (library-)global variables and complicated initialisation functions. I would expect Mathematica to optimise somehow functions calls with same parameters, but it does not appear to do that. Fallowing example is ran on Mathematica 9:               rands = Array[Random[] &, {2500, 2500}];     Timing[Inverse[rands];]     Timing[Inverse[rands];]     Timing[Inverse[rands];]     Timing[Inverse[rands];]      Output:               {0.687500, Null}     {0.687500, Null}     {0.687500, Null}     {0.687500, Null}      Is there a way to make Mathematica optimise revaluation with same parameters? What kind of nice workaround would you recommend? **EDIT** As I learned, the keyword I needed was _memoization_. I found this post very useful. Thanks!


Mathematica vs Sigmaplot (Non LinearModelFit)

I asked a question in a previous post that was closed because "The title of the question is not correct and the issue here is too trivial to help anyone later". NonLinearModelFit It's possible because I'm not so smart in _Mathematica_. But in this period I've tried a lot of alternative solutions. Recall my problem                data={{220., 542.821}, {225., 531.898}, {230., 521.391}, {235.,       510.596}, {240., 499.603}, {245., 488.585}, {250., 479.002}, {255.,       468.574}}      func= a0*Exp[a1 t + a2 t^2]      nlm = NonlinearModelFit[data, func , {a0, a1, a2}, t]      which gives the result:               FittelModel = 0.      Some answers told me that it is not an exponential, but linear problem. But this problem is a physical problem that comes out from a lot of papers that describes this phenomenum as having exponential behavior. So also if my question was trivial, I've continued to solve it. I read a lot of posts, and I tried this solution in _Mathematica_ , using `NMinimize` and not `NonLiNearModelFit`.               f[a0_, a1_, a2_][t_] := a0*Exp[a1*t + a2*t^2 ];     error[a0_, a1_, a2_][x_, y_] := (f[a0, a1, a2]@x - y);     errorSum[a0_, a1_, a2_] = Total[(error[a0, a1, a2] @@@ data)];     bestFitVals =      NMinimize[{errorSum[a0, a1,      a2], {600 < a0 < 1500&& -0.01 < a1 < 0 && -0.0000001 < a2 < 0}}(*,     Thread[0<{a0,a1,a2}]*), {a0, a1, a2}, Method -> "SimulatedAnnealing"]     soln[x_] = f[a0, a1, a2]@x /. bestFitVals[[2]]     limits = Flatten@{x, Through[{Min, Max}@data[[All, 1]]]};     Show@{Plot[soln@x, Evaluate@limits, PlotRange -> All],      ListPlot[data, PlotStyle -> Red]}      I tried all the methods available to `NMinimize`, changing starting values or removing them, but no choice works. So finally a collegue suggested that I try another software package: SigmaPlot. I said him that _Mathematica_ is superior, but Sigmaplot gives me an exponential solution, with these coefficients               a0 = 1072.637060511283     a1 = -2.128998307513597e-3     a2 = -4.390602833555603e-6.      and with residuals that are very low. I tried with another set of data, but the solution is the same: _Mathematica_ is not be able to regress or minimize and Sigmaplot is able to. I hope my question is not trivial, but I hope more that someone can solve my question: is Sigmaplot superior of _Mathematica_ , or is it the case that I'm not applying _Mathematica_ properly to my problem?


What are the scoping rules for function parameters shadowing System` symbols?

Here are some very contrived code snippets, highly unlikely to appear in real code, but still I am curious why they behave like this:               Function[List, {1, 2, 3}][Hold]     (* Hold[1, 2, 3] *)          Function[Function, Function[Slot[1]]][Hold]     (* Hold[#1] *)          Function[Slot, Function[Slot[1]]][Hold]     (* Hold[1] & *)          Function[Function, Function[x, 1]][Hold]     (* Function[x, 1] *) (* Why not Hold[x, 1]? *)          {Function[Null, Null][1]}     (* {Null} *) (* Why not {1}? *)      I think I understand the first 3 cases.   Could you please explain the last 2 results?


Problem displaying eps exported histograms in Word 2010

I am having problems displaying histograms exported as .eps in Word 2010. I don't have problems though displaying them in a specialized .eps viewer. (Postsript viewer from Rampant logic) I am writing histograms because there were no problems in exporting or displaying any other plot type.               plot = Histogram[RandomVariate[NormalDistribution[0, 1], 200]]     Export["plot.eps", plot]      ![Mathematica graphics](http://i.stack.imgur.com/bWH6X.png) Could it be that .eps files for histograms are corrupted? I did not find a way to attach the .eps file, so I hope that I am not the only person with this problem, although this is kind of wicked.


RegionPlot not working as expected

I was trying to evaluate the following expression:               RegionPlot[a > 0 && 2 a + b == 0, {a, -2, 2}, {b, -1.5, 1},         PlotLegends -> "Expressions"]      The output is: ![enter image description here](http://i.stack.imgur.com/2v6Ml.png) I think this is unexpected. Think about when $a = 0.5$. So, $b = -1$ which is within the range $[-1.5, 1]$. So, this values and other such values should be in a gray region in the plot. But they are not there. Any help?


Creating sums of elements from a list

I have a list $(d_1, d_2, .. d_k)$ and I want to create all sums that I get for adding only two elements for my list $(d_1+d_2, d_1+d_3,...d_{k-1}+d_k)$. The `RotateLeft` function gives me only some of my sums and I need all of them.


Embedded CDF Not Working

I happened to be looking at an old CDF (19 months old). It previously worked and does not now. It works if downloaded (opening or at URL). It requires dynamic functionality to be enabled but no longer prompts. I am uncertain how to resolve this. I apologise in advance if this is a duplicate and await redirection.


Computing a mean of median list of points

Given a array of lists with the same number of here N = 10 elements:               SuperList = {{5., 4.99667, 4.99335, 4.99002, 4.98669, 4.98337, 4.98004, 4.97671, 4.97338, 4.97006}, {5., 4.99667, 4.99335, 4.99002, 4.98669, 4.98337, 4.98004, 4.97671, 4.97338, 4.97006}, {5., 4.99667, 4.99335, 4.99002, 4.98669, 4.98337, 4.98004, 4.97671, 4.97338, 4.97006}, {5.,4.99667, 4.99335, 4.99002, 4.98669, 4.98337, 4.98004, 4.97671, 4.97338, 4.97006}, {5.1, 5.09667, 5.09335, 5.09002, 5.08669, 5.08337, 5.08004, 5.07671, 5.07338, 5.07006}, {5., 5., 5., 5., 5., 5., 5., 5., 5., 5.}, {5., 5., 5., 5., 5., 5., 5., 5., 5., 5.}, {5., 5., 5., 5., 5., 5., 5., 5., 5., 5.}, {5., 5., 5., 5., 5., 5., 5., 5., 5., 5.}, {5., 4.99667, 4.99335, 4.99002, 4.98669, 4.98337, 4.98004, 4.97671, 4.97338, 4.97006}};      How do I efficiently compute an array, which we'll call "MedianList" of length N where each element in the array is the median or mean of the sublist entries at the same index in the "SuperList"? For example, the first element would be:               MedianList[[1]] = Median[{5., 5., 5., 5., 5.1, 5., 5., 5., 5., 5.}];      The second element would be:               MedianList[[2]] = Median[{4.99667, 4.99667, 4.99667, 4.99667, 5.09667, 5., 5., 5., 5., 4.99667}];      And so forth.


What does "levelspec" mean in the documentation?

The following code returns the first three integer elements of `Sqrt[Range[100]]`:               Cases[Sqrt[Range[100]], _Integer, 2, 3]     {1, 2, 3}      The following code looks like the preceding code but returns a different result:               Cases[Sqrt[Range[100]], _Integer, {2}, 3]     {2, 3, 5}      As we can see in the following picture, the argument `{2}` is not documented (it has no braces in the documentation): ![enter image description here](http://i.stack.imgur.com/r0OZG.png) What does the second code with `{2}` instead of `2` mean?


How to solve for exponents in an infinite product?

Say I have a power series, $f(x,y) \in 1 + x\mathbb{Z}[[x,y]]$ Then it admits a unique expansion $$f(x,y) = \prod_{i=1}^\infty \prod_{j=0}^\infty (1 - x^i y^j)^{n_{i,j}}$$ for some integers, $i, j$. More to the point, the $n_{i,j}$ for $i \le N$ and $j \le M$ are determined uniquely by $$f(x,y) = 1 + \sum_{i=1}^N \sum_{j=0}^M f_{i,j} x^i y^j = \prod_{i=1}^N \prod_{j=0}^M (1 - x^i y^j)^{n_{i,j}} + O(x^{N+1}, y^{M+1})$$ > How do I solve for the $n_{i,j}$ given the $f_{i,j}$? In principle there is some matrix with integer coefficients that needs to be inverted, but do I have to first generate that matrix (how?) and invert it, or can I just write something like the above in Mathematica and say ``solve'' ?


Finding positions of multiple elements in lists

I realise that               Position[{2, 4, 8, 16, 32, 64}, 4]      will return               {{2}}      I would like to do something like this:               Position[{2, 4, 8, 16, 32, 64}, {4, 32, 64}]      and get               {{2}, {5}, {6}}      I have searched, but can't ind anything - I am clearly missing something obvious :/


How to export data from For loop in text file?

I'm new in Mathematica and I am trying to write numbers from 1 to 10 in txt file. But "Null" is everything that is written in my file. The code is:               Export["C:\\Users\\Sealy\\Desktop\\list.txt",            For[k = 1, k <= 10, k++, Print[List[k]]]]


Heavy duty operations, RAM, and Readyboost

I occasionally work with large 3D arrays and found that with calculations that take a long time, Mathematica completely fills my available RAM (6056 MB minus other active operations [mostly svchost]), and so completely bogs down my pc that it takes minutes to even [alt][dot] abort evaluation, or do anything at all in a different program. At one point I was working with an active 4 GB 2.0 USB plugged in with readyboost, and it prevented my computer from freezing. So my question, can I prevent Mathematica from freezing without the readyboost, and might upgrading to 8 GB RAM also solve the issue? To be clear, it doesn't run out of memory, it just takes up all working memory for the duration of the computations. I'm not sure if readyboost also increases performance, I know people usually disregard it for any but the lowest performing computers, but it's a lifesaver here.


How to generate random points in a region?

The Mathematica 10 documentation was updated for FindInstance adding support for regions. In my use case I'm trying to sample points in a set of disks:               region = DiscretizeRegion@RegionUnion@Table[Disk[RandomReal[4, {2}], RandomReal[1]], {10}]     FindInstance[{x, y} \[Element] region, {x, y}, Reals, 2] // N      However the above code fails and generates the following error:               FindInstance::elemc: "Unable to resolve the domain or region membership condition {x,y}\[Element]"      What's going wrong here?


Generating a (random) 2-dimensional cellular network

I want to generate a network of random cells like the following picture: ![enter image description here](http://i.stack.imgur.com/xYo3t.jpg) The general idea is to generate some random points (x,y) as coordinate of a vertex and then randomly choose some of these points to connect them to achieve (almost) a random cellular network since there are two constraints:   1. The length of edges is constant.   2. Degree of each vertex is 3. Thanks, _Update_ I have been thinking about this problem for a while. Here's the conclusion: By starting from a perfect honeycomb, we perform a series of random "neighbor switching" process: ![enter image description here](http://i.stack.imgur.com/6kOLg.png) By performing successive neighbor switching, we are able to build cells with different size.


How can I use BarChart to add label of the range of each set of data on the x axis?

( _My code:_ )               DataFirst = {0, -1, 0.5, 1, -4.5, 4.5, -0.5, 6, -4.5, 0, -1.5,                   1.5, -0.5, 2.5, 0, 2, -1, 2, -1, 2, -6.5, -3, 2.5, -3, -0.5, 2.5,                   5, 2.5, -3, -2.5, 1.5, -2, 2, -0.5, 3.5, -2.5, 2.5, -1,                   1.5, -1, -3.5, 1.5, -1, -1, -2, 5.5, 4, 1.5, -6, -1.5, 0, -1, 2, 4,                  3, -2, -0.5, 0.5, -0.5, 0, -0.5, -1, 2, -5, 2.5, 2.5,                   7, -2, -2.5, -2.5, 2, -2.5, 4, 2, 4, -5, 1.5, -1.5, 2, -2.5, -3,                   2, -1, -2.5, 1, 5, 3, -0.5, -2.5, 0.5, -0.5, 1, 0.5, 4, -0.5,                   1, -1, 1.5, 0.5, 2.5};     max = Max[DataFirst];     min = Min[DataFirst];     dx = (max - min)/10;     fi = BinCounts[DataFirst, {min, max, dx}]     BarChart[fi]      I want to show the range of each set of data on the x axis. ![enter image description here](http://i.stack.imgur.com/zt7X1.jpg) for example，`min` to `min+dx`, `min+dx` to `min+2*dx` and so on until `min+9 *dx` to `max` *)


How to dequantify units in mathematica?

Is there a function which applied to a quantity returns its numerical value so I for instance can fill it into my `Predictorfunction`?


Is there an equivalent of Sum for And?

Is there an equivalent to `Sum` for `And`? That is, just like instead of `Plus@@Table[f[i], {i,3,6}]` (or `Total@Table[f[i], {i,3,6}]`) you can write `Sum[f[i], {i,3,6}]`, is there a single pre-defined function that can replace `And@@Table[f[i], {i,3,6}]`? If not, is there a better alternative for `And@@Table[...]`? Note that, at least in Mathematica 8, `Conjunction` is not the right tool (despite the claim in the documentation that "`Conjunction` is to `And` what `Product` is to `Times`") because it only substitutes logical values, that is, it can only replace the special case `And@@Table[f[var], {var, {False, True}}]` (and of course multi-variable versions of the same structure).