Approximating a stochastic integral with a Wiener process

I would like some assistance to solve the following: $\sum\limits_{i=0}^{n-1} e^{-k(n\Delta t -i\Delta t)}\Delta z_i$ where $z$ is a Wiener process, $\Delta z_i = z((i+1)\Delta t)-z(i\Delta t)$. The code I have so far is as follows. I am very new to _Mathematica_ (and programming in general) so please let me know of any errors.               k = 0.5; t = 2; n = 100; M = 1000     Sum[       Exp[-k (n (t/n) - i (t/n))][WienerProcess[][(i + 1) (t/n)]] -          Exp[-k (n (t/n) - i (t/n))][WienerProcess[][i (t/n)]],        {i, 0, n - 1}]      Note that $k$, $t$, $n$ and $M$ are user defined inputs. Also, I would like some guidance on how to perform $M=1000$ simulations.


How can I create an image like this

I'm trying to get an algorithm that generates a picture like this ![enter image description here](http://i.stack.imgur.com/vfrVr.png) So far I've tried a little something with the help of the knowledge center, getting a graphics grid of squares already. But what now? I'm completely in the dark on how to trim it in the circle-shape I want. (If there are better solutions out there, please forget what I have started with. My only goal is to get the end result where I can make a pattern like this with variable size in terms of diameter in squares, size of the squares themselves and spacing in between.)               size = 10;     scalesize = 1;     table1 = Table[Graphics[Rectangle[]], {size}, {size}];          GraphicsGrid[table1, Frame -> None, Spacings -> Scaled[scalesize]]


random geometric graph generation problem

I'm new to Mathematica. I'm trying to generate a random geometric graph in which to have a secure link between any two arbitrary nodes they should share a common key in their key rings (have assigned some keys to each node) in order to get a random key graph but when I write `ShowGraph[g]` I'm unable to plot the graph. Here is my code.               v = {};     If[Length[v] == 0,      n = 100,(*Total number of nodes*)      n = Length[v];(*For pre-defined topologies*)      ]     nprime = 20;(*Average number of neighbours per node*)rc =       N[Sqrt[(nprime + 1)/(n*\[Pi])]]    (*Transmission range*)     rs = rc;(*Sensory range*)K = 4;(*Key ring size*)     Pstart = 10;(*Initial key pool size*)     Pend = 10;(*Last key pool size*)     If[Length[v] == 0,      nsim = 50,(*Number of iterations per P*)      nsim = 1;(*Only makes sense to simulate once for a fixed topology*)      ];     edist[xi_, yi_, xj_, yj_] := {Sqrt[(xi - xj)^2 + (yi - yj)^2], xi, yi};          If[euclidean == True,        dist[xi_, yi_, xj_, yj_] := edist[xi, yi, xj, yj],        dist[xi_, yi_, xj_, yj_] := tdist[xi, yi, xj, yj]];      (* * * * * * * * * * * _Main calculation_ * * * * * * * * * **)               (* * * * * * * * * * * * Main calculation * * * * * * * * * * * *)     For[P = Pstart, P <= Pend, P++,     For[sim = 1, sim <= nsim, sim++,         SeedRandom[sim];     (* Generate vertices if not using a fixed topology {{{ *)         If[Length[v] == 0 || sim > 1,                 v = {};                 For[i = 1, i <= n, i++, v = Append[v, {{Random[], Random[]}}]];             ];         g = Graph[{}, v];         Print["Vertices: ", v]; (* Debug *)          (* Distribute keys randomly {{{ *)         keyrings = {};         For[i = 1, i <= n, i++,                 keyring = {};                 If[P == K,                      For[k = 1, Length[keyring] < K, k++,                         keyring = Append[keyring, k]                     ],                     (* P > K *)                     For[k = 1, Length[keyring] < K, k++,                         key = Random[Integer, {1, P}];                         If[MemberQ[keyring, key] == False,                             keyring = Append[keyring, key]                         ]                     ]                 ];                 keyrings = Append[keyrings, keyring];             ];         Print["Key rings: ", keyrings]; (* Debug *)          (* Determine edges {{{ *)         For[i = 1, i <= n, i++,                 For[j = i + 1, j <= n, j++,                      xi = Extract[Extract[Extract[v, i], 1], 1];                     xj = Extract[Extract[Extract[v, j], 1], 1];                     yi = Extract[Extract[Extract[v, i], 1], 2];                     yj = Extract[Extract[Extract[v, j], 1], 2];                     If[dist[xi, yi, xj, yj][[1]] < rc,             If[Extract[keyrings, {i}] \[Intersection]           Extract[keyrings, {j}] != {},                             g = AddEdge[g, {{i, j}}],                             (* Else *)                             Print["No secure link between ",  i, " ", j]                         ]                     ]                 ]             ];     (*g=Graph[vertices,edgelst,VertexCoordinates\[Rule]v,     DirectedEdges\[Rule]False];*)         ShowGraph[g];     ]     ];      What’s the problem? Can anyone help?


Using transparency in ContourPlot makes mesh visible

I am trying to use a ColorFunction with Opacity in ContourPlot. Here's my code:               data = RandomVariate[BinormalDistribution[.75], 10];     d = SmoothKernelDistribution[data];     cf[z_] := {Opacity[z], Red};     sc1 = ContourPlot[        Evaluate@PDF[d, {x, y}], {x, -3, 3}, {y, -3, 3},         PlotRange -> All, PlotPoints -> 50, ColorFunction -> cf,         ColorFunctionScaling -> True]      And here's what it produces: ![enter image description here](http://i.stack.imgur.com/mT8td.png) How can the ugly mesh be avoided? I am using Mathematica 8.0.1 in OS X.


Mesh and ParametricPlot

Is this a bug, or something going over my head? When using the following code, nothing "special" happens:               ParametricPlot[a {Cos[t], Sin[t]}, {a, 1, 2}, {t, 0, 2 Pi},       Mesh -> None, PlotStyle -> Opacity[0.2]]      it works as expected, one gets this graphic, without any mesh lines: ![enter image description here](http://i.stack.imgur.com/uY41e.png) When adding `Graphics[]` in front of that—as I'd like to `Show` such a `ParametricPlot` with some other graphics, I get this:               Show[      Graphics[],      ParametricPlot[a {Cos[t], Sin[t]}, {a, 1, 2}, {t, 0, 2 Pi},        Mesh -> None, PlotStyle -> Opacity[0.2]]      ]      yields: ![enter image description here](http://i.stack.imgur.com/m2Ggy.png) Why do those mesh-lines come up? Are those actually Mesh-lines, as I used `Mesh -> None`? How can I delete those lines, while still using `Show` and others `Graphics[]`? Thanks for all help!


parameter NDSolve

the question I need to solve is:               t x'[t] == -x[t] + y[t],       t y'[t] == -5 t^2/x[t]^2 + x[t] - y[t],            x[1] == 4, x[b] == 1      in order to solve the coupled equations, I need 2 boundaries for `x[1]` and `y[1]`, so I can convert the question into shooting method               {xsoln, ysoln} = {x, y} /. ParametricNDSolve[{  t x'[t] == -x[t] + y[t],       t y'[t] == -5 t^2/x[t]^2 + x[t] - y[t],     x[1] == 4, y[1] == a}, {x, y}, {t, 1, b}, {a,b}]      for each specific value of `b`, I can find the value of `a` which satisfies `x[b]==1` manually. But if there is any possibility that I can find the value of `a` for any value of `b` instead of plugging the value of `b` and repeating the above process. the way I am getting the value of `a` is as follows: first I set `b=100`, then I plot `xsoln[a][100]`, then I can locate the region of `a` which satisfies `x[100]==1`, so I use `findroot` to find the exact value of `a`. I naively set `f[b_?NumericQ]:=a/.FindRoot[xsoln[a][b]==1,{a,0}]`, so for any `b`, I have the value of `a`. But `xsol[a][b]` is not well behaved. I can not set `FindRoot` at `a` around `0`, the starting point differs for different `b`, which can only be seted by plotting the profile and detect the starting point. my another idea is by adding `WhenEvent` into `NDSolve`, which is like `WhenEvent[xsoln[a][b] does not equal to 1, change the value of a, and do the calculation again]` Thanks folks


Automatic replacing of [ with []

I tried to modify the `KeyEventTranslations.tr` file in order to always place a closed bracket instead of an open bracket once I press `[`. However once I press `[` after the modification nothing happens (the cursor just stays at the same position and not even a `[` is placed).               Item[KeyEvent["["],             FrontEndExecute[{                 FrontEnd`NotebookWrite[FrontEnd`InputNotebook[],                     "[", After],                 FrontEnd`NotebookWrite[FrontEnd`InputNotebook[],                     "]", Before]             }]],       the Code is a slight modification of what i found regarding double brackets: Automating Esc [[ Esc formatting? (There is a comment below the top answer, which also mentions Problems regarding `[` and German keyboard language). If I use a different character like `/` to trigger the `KeyEvent`, which does not have to be typed using the AltGr-key               Item[KeyEvent["/"],             FrontEndExecute[{                 FrontEnd`NotebookWrite[FrontEnd`InputNotebook[],                     "[", After],                 FrontEnd`NotebookWrite[FrontEnd`InputNotebook[],                     "]", Before]             }]],       the closed bracket will be placed as expected. Other keys like `{` using `AltGr` do not work either. I tried renaming the `term.dll` files as suggested here: Is it possible to get AltGr key to work in Math.exe? unfortunately this did not fix the Problem. Additional Information: I'm using Win7 and my keyboard language is set to German. (And I would like to keep it set to German). If there is any other way circumventing the `KeyEventTranslations.tr` to automaticaly place `[]` with the cursor placed between the brackets once I press `[`, it would be fine as well. Thanks in advance if anyone tries to answer my question :)


Reading from a text file and store the results back into it

I am totally new to mathematica but started learning how to use it. I use the following function to convert a decimal number into its binary representation.               binExp[num_, d_] := First[RealDigits[N[num, d], 2]];      Currently, I am stuck with two points:   1. If I type `binExp[240, 7]`, I get a 23-bit binary representation of a decimal number in the interval `[0,255]` BUT I need a 24-bit binary representation of it.   2. I have a `100,000` decimal numbers stored in a text file and want to use the previous function within mathematica to convert all of them to their 24-bit binary representation and store them back in a text file. Any help is appreciated.


Subgraph, HighlightGraph not acting as expected

I'm trying to create a simple graph from a matrix and then highlight a particular subgraph. My code (simplified from a bigger task) is as follows. I keep getting the "Subgraph::graph: A graph object is expected at position 1" message whenever I try to use Subgraph (or HighlightGraph). What might I be doing wrong? Thanks in advance for the help.               << Combinatorica`      > General::compat: Combinatorica Graph and Permutations functionality has been > superseded by preloaded functionality. The package now being loaded may > conflict with this. Please see the Compatibility Guide for details.               BB = Table[0, {i, 4}, {j, 4}];     BB[[1]][[2]] = 1;     BB[[2]][[1]] = 1;     BB      > {{0, 1, 0, 0}, {1, 0, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 0}}               Gr = FromAdjacencyMatrix[BB];     Subgraph[Gr, {1, 2}]      > Subgraph::graph: A graph object is expected at position 1 in > RowBox[{"Subgraph", "[", > RowBox[{InterpretationBox[StyleBox[RowBox[{"[SkeletonIndicator]", "Graph:<", > 0, ",", 4, ",", "Undirected", ">[SkeletonIndicator]"}], ShowAutoStyles -> > False, AutoSpacing -> False], Graph[{}, {{{0, 1.}}, {{-1., 0}}, {{0, -1.}}, > {{1., 0}}}], Editable -> False], ",", ({1, 2})}], "]"}]. >>


Given a Table of Plots with some parameter, how would I mark each of the plots with that parameter

I've got a two variable function that I'm plotting against one axis for a few different values of a parameter               Clear[f, r]     f[r_] := 4 r /(1 - r)^2     i[r_, delta_] := 1/(1 + f[r] Sin[delta/2]^2)     Show[      Table[ Plot[i[r, delta], {delta, 0, 4 Pi},        PlotRange -> {0, 1}], {r, {0.1, 0.3, 0.6, 0.97}}]      ]      This looks like ![Plot of etalon interference](http://i.stack.imgur.com/jd5PZ.png) but I'd like to label each of the curves with the value of the parameter (`r = 0.1`, `r = 0.3`, ...). I can do this manually inserting labels with the Graphics controls, but figured there's got to be a better way.


How to test if file exists and stop

At the moment I'm using >               filename = FileNameJoin[{root = "F:\\somefolderpath", file = "somefile.extention"}];     If[! DirectoryQ[root],        Print[Style["Directory '" <> root <> "' does not exist!", {Red, Bold, Large}]]; Quit[]];     If[! FileExistsQ[filename],        Print[Style["File '" <> filename <> "' does not exist!", {Red, Bold, Large}]]; Quit[]];     (*Start using 'filename'*)      edit: Ended up using               SafeFile::usage = "Use instead of Import.";     SafeFile::nodir = "Directory `1` does not exist.";     SafeFile::nofile = "File `1` does not exist.";     SafeFile[filename_,root_:NotebookDirectory[]]:=Module[{         fullfilename=FileNameJoin[{root,filename}]     },         If[!TrueQ@DirectoryQ@root,Message[SafeFile::nodir,root];Quit[]];         If[!TrueQ@FileExistsQ@fullfilename,Message[SafeFile::nofile,filename];Quit[]];         Import[fullfilename]     ]      Quitting kernel was actually what I needed.


Ugly output when combining 2 plots with GraphicsRow

Here are the data that I want to plot:               meandatf1 = Mean /@ datf1     meandatf2 = Mean /@ datf2          {1.48908, 1.49641, 1.49354, 1.50385, 1.49835, 1.49617, 1.50569, \     1.50117, 1.50226, 1.50151, 1.50108, 1.50031, 1.49955, 1.49721, \     1.49898, 1.50266, 1.50177, 1.50227, 1.49886, 1.50002}          {-0.00127783, 0.000556012, 0.0000143709, -0.000602328, -0.000375952, \     -0.00125357, 0.0000228143, 0.000175103, 0.000868018, -0.0003298, \     0.000230178, 0.000222689, -0.0000624273, -0.0000760139, -0.000263302, \     0.0000826082, 0.000206463, 0.0000507921, -0.0000955452, 0.000184107}      And here is how I generate my individual plots:               genPlot[c_, dat_, ymin_, ymax_, legend_] :=      ListPlot[{        Table[c, {Length[dat]}], dat},        AxesLabel -> {"N", "\[Mu]"}, PlotRange -> {Automatic, {ymin, ymax}},        PlotLegends -> Placed[legend, Above],        Joined -> True, Mesh -> None, InterpolationOrder -> 0,         ImageSize -> 400] (* I tried also without ImageSize, see below *)          plot1 = genPlot[3/2, meandatf1,  1.45,  1.55,  "\[ScriptCapitalD]1"]     plot2 = genPlot[0,   meandatf2, -0.004, 0.004, "\[ScriptCapitalD]2"]      The output of the individual plots is fine: ![enter image description here](http://i.stack.imgur.com/gOVTt.png) But when I combine the two plots with `GraphicsRow[]` I get this ugly output: ![enter image description here](http://i.stack.imgur.com/vJUfz.png) When I don't specify `ImageSize` in `genPlot[]` the combined plot is very small (but otherwise looks fine): ![enter image description here](http://i.stack.imgur.com/b3cQJ.png) If I set `ImageSize` in the `GraphicsRow[]` (and not in `genPlot[]`) the container image is increased instead of the contained cells (which is reasonable, but was a desperate long shot by my side): ![enter image description here](http://i.stack.imgur.com/ARihe.png) It must be something trivial that I am missing. Any ideas? **EDIT1** : I am using _Mathematica_ 9.0.1 under Mac OSX Mavericks. **EDIT2** : Pretty much all of the proposed solutions worked for me. I wish I could accept >1 but, since this is not possible, I'll accept the one from @JasonB for its beauty of simplicity.


How can I compute the chromatic index and number of a graph?

I saw a recent question from M.R. and realized there is no function to compute the chromatic index and number of a graph, other than a really slow method in the now deprecated _Combinatorica_. So, how can I compute the chromatic index and number of a graph?


Locking a value when Manipulating variables

I'm trying to achieve something similar to Bret Victor's brilliant Scrubbing Calculator in Mathematica. By using Manipulate I'd like to change the values of the variables such that if I modify one the others adapt to ensure the equation is always true. In the example below I'd like to be able to move spaces and have boxes change accordingly.               Manipulate[4 spaces + 3 boxes = 640, {spaces, 0, 640}, {boxes, 0, 640}]      ![The simplest case](http://i.stack.imgur.com/cHgE2.png) Solving for the two variables explicitly I can achieve the desired effect but doing so kind of voids the idea of an intuitive calculator.               Manipulate[{Dynamic[spaces = 160 - (3 boxes)/4],        Dynamic[boxes = -(4/3) (spaces - 160)]}, {boxes, 0, 640}, {spaces,        0, 640}]      ![The hard way](http://i.stack.imgur.com/fAX5N.png) Now, kind Mathematicans, my question is this: Is there a way of doing this the first, more intuitive, way?


Graphing the sequence {$p_k$} = $\frac{c - a + dp_{k-1}}{b}$ I need to know how to graph this function where it automatically plugs in the previous term for $p_{k-1}$, the coefficients are of my choosing lets just say $a=1$, $b=3$, $c=2$, $d=-1$, these numbers are arbitrary. The whole point is that i want to find out what coefficients will make this oscillate.


Jacobian matrix formation from polynomial expressions

I want to find the jacobian matrix for 3 polynomial expression with 3 variables.. the polynomial expressions have the degree of 8.how to form it.?


Select Cells to End of Notebook

I'd like to create a keyboard shortcut that will allow me to select all of the cells from the current cell until the end of the notebook, similar to how `Shift``Ctrl``End` functions when editing text in most Windows applications. By editing `KeyEventTranslations.tr`, I've already created a shortcut using `Shift``Ctrl``A` that allows me to select the current cell (rather then pressing `Ctrl``.` repeatedly). I'd like to then use another shortcut that would allow me to avoid having to hold down `Shift` and press `↓` over and over until I reach the bottom. Any ideas?


Maximization of a 3-variable function

So I define a 3-variable function $h$ and I want to find the maximum of $h$ in a region $\mathcal{R}$:               h[x_, y_, z_] := y (a - z) - z (a - t) + (y + x) (Max[0, b - (y - z)] - x + 1)     Maximize[{h[x, y, z], 0 <= z <= t, z <= y <= a, 0 <= x <= Max[0, b - (y - z)]}, {x, y, z}]      Here I'm treating $a,b,t$ as constants. Shouldn't Mathematica return the maximum of $h$ as a function of $a,b,t$?


Density plot on the surface of sphere

I would like to make density plots of a list of (size 2 or 3) spherical harmonics on the surface of a sphere. I'd like to plot it so that each element of that list is using a different color (red density plot for the first one, blue for the next, green... and so on) I tried using `ColorFunction` like               SphericalPlot3D[1, {θ, 0, Pi}, {ϕ, 0, 2 Pi},       ColorFunction ->        Function[{x, y, z, θ, ϕ, r},         RGBColor[Abs[SphericalHarmonicY[1, 1, θ, ϕ]]^2,          Abs[SphericalHarmonicY[1, 0, θ, ϕ]]^2,          Abs[SphericalHarmonicY[1, -1, θ, ϕ]]^2]]]      but all I get is some dark-green sphere. Is there a function like `SphericalDensityPlot` so that I can illustrate the functions? Also, a big problem I'm running into is the ambient lighting direction, which interferes with what it's supposed to look like.


Visualizing 3D vector field on surface of sphere

I want to vizualize (quite complicated) 3D vector field which has both real and imaginary part and is expressed in spherical coordinates. I was thinking about expressing the field for certain _r_ and then plotting Norm of the vector field on the surface of sphere as some color map. Can anyone give me advice how to do it, please?


How to protect functions in a Mathematica Package?

I'm writing a Mathematica Package with many functions, but only two can be seen/public. I have:               BeginPackage["VolumeReserves`"];          startInterface::usage = "...";          detailRock::usage = "...";          (* Implementation of functions *)          Begin["`private`"];          global private and initialized variables;          startInterface[___] := ...          detailRock[___] := ...          f1[] := ...          f2[] := ...          f3[] := ...               (* And finally I do: *)          SetAttributes[startInterface, {Protected, Locked}];     SetAttributes[detailRock, {Protected, Locked}];     SetAttributes[f1, {Protected, Locked}];     SetAttributes[f2, {Protected, Locked}];     SetAttributes[f3, {Protected, Locked}];          End[];     EndPackage[];      When I open a new notebook and I load the package for the first time with:               SetDirectory[StringJoin[NotebookDirectory[]]];     << VolumeReserves`      Everything is OK, but if I evaluate the notebook one more time (and so on) I get:               Set::write: Tag startInterface in startInterface[___] is Protected. >>     Set::write: Tag detailRock in detailRock[] is Protected. >>     Set::write: Tag f1 in detailRock[] is Protected. >>     ...     General::stop: Further output of SetDelayed::write will be suppressed during this calculation. >>      So this is a little strange... Why can't I reload/re-evaluate the notebook/package? Should I quit the kernel every time? I've tried to evaluate some of Mathematica Packages, such ComputerArithmetic, more than once, and it doesn't show that error...


Finding neighbors from list

Say you are given the following list:               list={{3, 2, 1}, {3, 4, 2}, {2, 4, 1}, {1, 4, 3}};      Two numbers $x,y$, not necessarily distinct, are neighbors if one of the sub- lists contains both of $x$ and $y$. In more precise mathematical language: let $S=\{A_1,A_2,\dots,A_n\}$ be a collection of $n$ sets, each containing integers between $1$ and $m$. Then $x$ and $y$ are neighbors if $\exists A_i:x,y\in A_i$. I am looking for an efficient way of finding all the neighbors of each element. That is, let $S'=\{B_1,B_2,\dots,B_m\}$. Then $B_i$ contains all the neighbors of $i$. Note that $B_i$ may be empty if the integer $i$ does not appear in any of the sets in $S$. My current implementation is:               Union @@@Function[x, Select[list, MemberQ[#, x] &]] /@ Range@Max@list          (*{{1, 2, 3, 4}, {1, 2, 3, 4}, {1, 2, 3, 4}, {1, 2, 3, 4}}*)      However, it gets fairly slow on large lists. Is there a more efficient way of finding $S'$ in Mathematica?


importing a file with asterisk in its name (Linux machines)

I am trying to import a file:               filename = "furan.b3lyp.6-31G*.sdat"     path = "/home/molkee/Desktop/plots/scr/" <> filename;     FileExistsQ[path]     data = Import[path, "Table"];      I am getting the _Recursion Limit_ error. I guess this happens because of the asterisk in the filename, but why? What is going on? What is the right way to import it? FILE


Energy Equation: Boundary and initial condition

I'm trying to solve the energy equation and NDSolve is able to solve the problem. Even though the result is acceptable, I have always the warning "boundary and initial conditions are inconsistent". I've been trying a lot of function in order to solve this inconsistence, but I couldn't. The energy equation in cylindrical coordinate is:                (df*cf*(D[tf[x, r, t], t] + mom[r]*D[tf[x, r, t], x])) == ((1/r)*         D[(r*kf*D[tf[x, r, t], r]), r])       The initial condition is: 1) tf[x,r,0]==298 The boundary conditions are:   * 1) tf[0,r,t]==373   * 2) (D[tf[x, r, t], r] /. r -> 0.0000001) == 0 (for r=0 there is a discontinuity due to mom[r], the velocity profile)   * 3) kf*(D[tf[x, r, t], r] /. r -> (r0/1000)) == hi*(335 - 298) (this bc is not respected by Mathematica). Could some one help me? Thank you!


Equating and solving equations that have been generated using table[]

I am in the process of trying to use Mathematica to find the coefficients of transmission and reflection for the wavefunction of a beam of particles tunnelling across any number of identical potential barriers. I have got to the stage where I am able to generate the equations for n numbers of barriers, but I am not able to equate the appropriate equations to each other to solve them for the coefficients. The module I have written to generate the relavant equations is:               GeneratePhiEqs[N_] :=         Module[{inceqs, diffinceqs, bareqs, diffbareqs, finaleq, difffinaleq,         IncidentPhi, BarrierPhi, FinalTransmittedPhi, phieqs},          IncidentPhi[x_, n_] := T[n]*E^(I*k*x) + R[n]*E^(-I*k*x);         BarrierPhi[x_, n_] := A[n]*E^(r*x) + B[n]*E^(-r*x);         FinalTransmittedPhi[x_, n_] := T[n]*E^(I*k*x); T[0] = 1;              inceqs = Table[Phi[j] = {IncidentPhi[x, j]}, {j, 0, N}];         diffinceqs =          Table[Phi[N + j] = {D[IncidentPhi[x, j], x]}, {j, 0, N - 1}];         bareqs = Table[Phi[2 N + j - 1] = {BarrierPhi[x, j]}, {j, N}];         diffbareqs =          Table[Phi[3 N + j - 1] = {D[BarrierPhi[x, j], x]}, {j, N}];         finaleq = Phi[4 N] = FinalTransmittedPhi[ x, N];         difffinaleq = Phi[4 N + 1] = D[FinalTransmittedPhi[x, N], x];         phieqs = {inceqs, diffinceqs, bareqs, diffbareqs, finaleq,          difffinaleq}; phieqs]      The module I have written (or what it looks like so far) to equate the relevant equations is:               SolvePhiEqs[number_] :=          Module[{eqs, simeqs}, eqs = GeneratePhiEqs[number];          simeqs = Table[{Phi[j] /. phieqs == Phi[2*number + j] /.          phieqs}, {j, 2*number - 1}]; simeqs]       Basically, the equations that I generated with the first module will not substitute in correctly, they just remain isolated from each other surrounded by curly brackets. Any suggestions would be much appreciated! Thanks.


Performing a chi-square goodness of fit test

How would I perform a chi-square goodness of fit test? I have tried the following, where my data consists of the observed values whilst the data pair contains the correct values. Then I use the `DistributionFitTest` on the data and the data pair.               data = {115, 188, 97};     datapair = {100, 200, 100};     DistributionFitTest[datapair, data]          (* Out= 0.248213 *)      However the result I get is `0.248` and should be `0.216`. Am I doing something wrong? And how would I measure the $\chi^2$ value?


Image convolution, motion blur

I define my degradation function as $$H(x,y;a,b,t)=\frac{T}{z}\sin z~e^{-jz}$$ where $$z=\pi(ax+by)$$ So I write               H[a_, b_, T_] :=        Function[{x, y}, z = Pi*(a*x + b*y); If[z == 0, T, T*N[Sin[z]*Exp[-I*z]/z]]];      But when I convolve it with image               Image[Abs[InverseFourier[Fourier[img]*Array[H[a, b, T], {row, col}]]], "Real"]      The blurred image is almost white. What's wrong with my program? ### Edit Here is my runnable program               img = Import["Lena.tif", "Data"];     {row, col} = Dimensions[img];     H[a_, b_, T_] := Function[{x, y}, z = Pi*(a*x+b*y); T*N[Sinc[z]*Exp[-I*z]]];     filter = Array[H[0.1, 0.1, 1], {row, col}];     Image[Abs[InverseFourier[Fourier[img]*filter]], "Real"]


Question about making TabView remember what tab to open

Background: Consider the following ( for the purpose of illustrating this question ) simplified, but working snippet of code.                TabView[       {        {patt, "Pattern" -> 1},        {motif, "Motif" -> Column[{           Button["Type", Print[" NOT IMPLEMENTED YET"], ImageSize -> 100],           Button["New shape", Print[" NOT IMPLEMENTED YET"], ImageSize -> 100],           Button["Pixel", Print[" NOT IMPLEMENTED YET"], ImageSize -> 100]}]}       },       Dynamic[tab]]      I have a GUI in a Module / Manipulate construction which contains a tabview that displays several views of the same data on its tabs. Each tab contains a series of buttons to further specify the particular view on that tab. Each tab consists several buttons and other controls, i.e. setterbars, 2D sliders. After each click or other action on a control the data is modified and all views are recalculated and displayed on the tabs. The issue is that after each tab the tabview always returns to page 1. I have already made accomodations by using the following format of TabView:                 TabView[{         {value1, "Tabname"->CodeOnTab1},         {valueN, "Tabname"->CodeOnTabn} },        Dynamic[VAR]      As I understand the Tabview opens tabN if VAR is set to valueN. This leads to the following question: what is the best =coding strategy= to make a TabView aware of the tab it should display ( open ) when it is re-displayed ( considering the last user action ) ? **The goal / criteria is: minimal code use.**


Lorenz map for the Rössler system

> **Possible Duplicate:**   >  How to find all the local minima/maxima in a range I have the solution of the following non-linear system:               sol1 = NDSolve[       {x'[t] == -(y[t] + z[t]),        y'[t] == x[t] + 0.2 y[t],        z'[t] == 0.2 + x[t] z[t] - 5.7 z[t],        x[0] == 1, y[0] == 1, z[0] == 1       },       {x, y, z},       {t, 0, 100}       ]      How can I find the $k^{th}$ local maximum of $z(t)$, i.e. $z(k)$, and then plot $z(k+1)$ vs. $z(k)$? There is an example in the "Mapping local maxima" section in Rössler attractor's wiki page. I am working with Wolfram Mathematica 8.0.


Find all points that have the same minimum?

> **Possible Duplicate:**   >  How to find all the local minima/maxima in a range `Sin[x]` have two points ($3\pi/2,7\pi/2$) where the same minimum ($-1$) is achieved at the range from $0$ to 4 $\pi$. I don't know how to get two points at once, if using `Minimize`, only only one point can be got.               Minimize[{Sin[x], 0 <= x <= 4 Pi}, x]      the output: > `{-1, {x -> (7 \\[Pi])/2}}` And the last sentence of the information about `Minimize` gives a definitely declaration, which almost cut off this road: > Even if the same minimum is achieved at several points, only one is > returned. Other similar function like `FindMinimum` seems to be helpless either,so are there any methods to help achieve that goal?


How to obtain all minima?

If you `Solve` an equation, you obtain _all_ solutions. But If you `NMinimize` a function, you only get one minimum. The question is: is there a way to obtain all minima of a given function? Example:               Solve[((x - 2) (x + 2))^2 == 0, x]     Print["____________"]     NMinimize[((x - 2) (x + 2))^2, x]     NMinimize[ {((x - 2) (x + 2))^2, x >= 0}, x]      yields               {{x -> -2}, {x -> -2}, {x -> 2}, {x -> 2}}     ____________     {0., {x -> -2.}}     {0., {x -> 2.}}      You can see that for `Solve` you obtain all solutions, even with their multiplicity, but in the minimization, you only obtain one solution.


ParallelTable and expensive functions

I would like to build up a 2D-Table using `ParallelTable` as follows               tab = Flatten[ParallelTable[{i,j,f[i,j]},{i,1,ni},{j,1,nj}],1];      This instruction works perfectly. However, I would like to speed it up. Indeed, the function `f[i,j]` is defined as `f[i_,j_] := f1[i] f2[i,j]` The particularity here is that `f1[i]` is expensive to compute, so that I would like to compute it only one time for each `i`. How would it be possible to tune the `ParallelTable` so that `f1[i]` is only evaluated when it has never been done before ? A kind of _nested_ `ParallelTable` ? Using _memoization_ ? (As the construction of the table remains long, it is key for me to necessarily use parallelized evaluations on multiples cores)


Missing arrow tips and colors

**My main problem is:** I plotted a curve here, but the tip of some arrows are missing. Why does this happen, and how can I fix this? _Not the main problem:_ Also, I once tried to make the arrows with different colors, but all of them would be of the same color as the first one. How can I make them different colors? And I have a strong impression that I'm not being intelligent using `Graphics3D` all this much, for every single arrow. It must have a cleaner way to do it. (Maybe I should ask a different question for this, but I don't want to flood the site. If you can help me with the main problem, I'll be happy already) [ **EDIT:** wxffles already helped me with this issue in the comments. What is left is the main problem now.] ![enter image description here](http://i.stack.imgur.com/ssdqE.png) The code as it is now, in case it helps:               a[t_] := {1 + Cos[t], Sin[t], 2 Sin[t/2]}     tf[t_] := {(-Sin[t])/(Sqrt[1 + Cos[t/2]^2]), (Cos[t])/(Sqrt[          1 + Cos[t/2]^2]), (Cos[t/2])/(Sqrt[1 + Cos[t/2]^2])}     bf[t_] :=       Rationalize@{(-0.5 Cos[t] Sin[t/2] + Cos[t/2] Sin[t])/          Sqrt[1.625 + 0.375 Cos[t]], (-Cos[t/2] Cos[t] -            0.5 Sin[t/2] Sin[t])/Sqrt[1.625 + 0.375 Cos[t]],         1/Sqrt[1.625 + 0.375 Cos[t]]}     nf[t_] := {-((3 + 12 Cos[t] + Cos[2 t])/(        2 Sqrt[3 + Cos[t]] Sqrt[13 + 3 Cos[t]])), -(((6 + Cos[t]) Sin[t])/(        Sqrt[3 + Cos[t]] Sqrt[13 + 3 Cos[t]])), -((2 Sin[t/2])/(        Sqrt[3 + Cos[t]] Sqrt[13 + 3 Cos[t]]))}                   Show[ParametricPlot3D[{1 + Cos[t], Sin[t], 2 Sin[t/2]}, {t, 0,             4 \[Pi]},            PlotStyle -> Directive[RGBColor[0.91`, 0.`, 0.`], Opacity[1.`]],            BoxRatios -> {1, 1, 1}, Boxed -> False, AxesOrigin -> {0, 0, 0}],           Graphics3D[Arrowheads[0.02], Arrow[{a[0], a[0] + tf[0]}]],           Graphics3D[Arrow[{a[0], a[0] + tf[0]}]],           Graphics3D[Arrow[{a[1], a[1] + tf[1]}]],           Graphics3D[Arrow[{a[Pi/2], a[Pi/2] + tf[Pi/2]}]],           Graphics3D[Arrow[{a[2], a[2] + tf[2]}]],           Graphics3D[Arrow[{a[Pi], a[Pi] + tf[Pi]}]],           Graphics3D[Arrow[{a[3 Pi/2], a[3 Pi/2] + tf[3 Pi/2]}]],           Graphics3D[Arrow[{a[2 Pi], a[2 Pi] + tf[2 Pi]}]],           Graphics3D[Arrow[{a[0], a[0] + bf[0]}]],           Graphics3D[Arrow[{a[0], a[0] + bf[0]}]],           Graphics3D[Arrow[{a[1], a[1] + bf[1]}]],           Graphics3D[Arrow[{a[Pi/2], a[Pi/2] + bf[Pi/2]}]],           Graphics3D[Arrow[{a[2], a[2] + bf[2]}]],           Graphics3D[Arrow[{a[Pi], a[Pi] + bf[Pi]}]],           Graphics3D[Arrow[{a[3 Pi/2], a[3 Pi/2] + bf[3 Pi/2]}]],           Graphics3D[Arrow[{a[2 Pi], a[2 Pi] + bf[2 Pi]}]],           Graphics3D[Arrow[{a[0], a[0] + nf[0]}]],           Graphics3D[Arrow[{a[0], a[0] + nf[0]}]],           Graphics3D[Arrow[{a[1], a[1] + nf[1]}]],           Graphics3D[Arrow[{a[Pi/2], a[Pi/2] + nf[Pi/2]}]],           Graphics3D[Arrow[{a[2], a[2] + nf[2]}]],           Graphics3D[Arrow[{a[Pi], a[Pi] + nf[Pi]}]],           Graphics3D[Arrow[{a[3 Pi/2], a[3 Pi/2] + nf[3 Pi/2]}]],           Graphics3D[Arrow[{a[2 Pi], a[2 Pi] + nf[2 Pi]}]]]      Thanks for your time.


3D view of a route shown on a map

You should have already seen such a thing, specially in documentaries about ancient life: the movement of a tribe is shown on an ancient map along a route with a dashed arrow. I want to do the same thing in Mathematica. Given a bitmap image of a map like this one and a list of points on the 2d map such as `{{123,233}, {177, 279}, ...}`, I want to make a movie that shows an arrow along the given route on the map. The movie looks like it is captured from a helicopter flying on the map. _Edit:_ This is what I did after `rm -rf♦`'s comment:               map = ImageResize[        Import["http://upload.wikimedia.org/wikipedia/commons/e/e3/China_\     old_map.jpg"], 500];     path = .3 {{300, 500}, {350, 600}, {450, 700}, {600, 750}, {650,           750}, {700, 780}, {800, 800}, {850, 900}, {900, 1000}, {1000,           1050}, {1100, 1050}, {1150, 1100}};     ListAnimate[      Table[Show[map, Graphics[{Thick, Dashed, Arrow[Take[path, i]]}],         ImageSize -> {500}], {i, Length@path}]]


Measure relative lengths of rectangular objects

I'm working on a method for measuring the relative lengths of the objects, with the intention of showing that the objects are longer in the center of the image that at the top/bottom. The image is binarized, with some small dots that look like noise. Measuring the object lengths is made more difficult by the fact that some are broken. (I can use dilation to fix this) `ImageTake[b, {390, 660}, {733, 1016}] // ColorNegate` TOP ![enter image description here](http://i.stack.imgur.com/rPhH6.jpg) BOTTOM The original image is taken from the blue channel and looks almost identical to the above A quick method I have tried is to use the `ComponentsMeasurements[]` function that can return the longest axis of the best shape ellipse - but I'm not sure if that function works on the individual objects in the image. **Question 1** - Does the above method measure the best fit ellipse for each object (line) or does it do for groups of lines in the image instead? **Question 2** - I was going to use a iterative search in each row to identify the start end end locations for each object for measuring their relative lengths (longest axis in pixels). Doing this for all objects is not necessary, only to show that objects get longer towards the centre of the image. If you have a better idea then I would be very grateful if you would share your thoughts. Regards, * * * Thanks Carmullion. I would prefer not to use ComponentMeasurements as I am not sure if it measures individuals or small groups of objects (used an image with different dimensions to get the following results): `test3 = ComponentMeasurements[MorphologicalComponents[bResize], "Length"];` `ListPlot[data, PlotRange -> {{0, 397}, {0, 35}}, AxesLabel -> {"Height/pxls", "Length"}]` Small objects (noise) accounts for the points that span the scatter plot close to the axes. I can get rid / minimize these by adjusting the `Binarize` parameter ![enter image description here][2]


How to frame a PairedHistogram and manipulate the frame ticks?

How can I `Frame` a `PairedHistogram` and manipulate the frame ticks? I want to specify and control the frame ticks in the paired histogram below.               spacez = RandomVariate[PoissonDistribution[11], 1000];     spacem = RandomVariate[PoissonDistribution[11], 1000];     PairedHistogram[spacez, spacem, {1, 11, 1}, PlotRange -> {{All, All}},       ChartStyle -> {{Red, Blue}}, BaseStyle -> {FontSize -> 24},       AxesStyle -> Thick, BarSpacing -> 0,       ColorFunction -> Function[Opacity[0.5]], BarOrigin -> "XAxis"]      ![enter image description here](http://i.stack.imgur.com/56cNC.jpg)


How to construct a stacked barchart

UPDATED to clearify I want to construct a stacked barchart from a list with three elements:               list = Table[{i, x, y}, {i, 10}]       where x has a value between 0 and 100, and y has a value between 0 and 100 so it looks like this:               llist = {{1, 6, 611}, {2, 57, 732}, {3, 5, 526}, {4, 91, 72}, {5, 45,      583}, {6, 98, 552}, {7, 16, 981}, {8, 54, 439}, {9, 80, 804}, {10,      9, 633}};      I want to stack y based on brackets of x (eg. brackets of size 10). Based on the list above this gives the following brackets.   * Bracket `0 - 10` consists of $y$ value (s) `611, 526, 633`   * Bracket `10 - 20` consists of $y$ value (s) `981`   * Bracket `20 - 30` consists of $y$ value (s) empty    * Bracket `30 - 40` consists of $y$ value (s) empty    * Bracket `40 - 50` consists of $y$ value (s) `583`   * Bracket `50 - 60` consists of $y$ value (s) `732, 439`   * Bracket `70 - 80` consists of $y$ value (s) empty    * Bracket `80 - 90` consists of $y$ value (s) `804`   * Bracket `90 - 100` consists of $y$ value (s) `72, 552` The result should look something like this: ![enter image description here](http://i.stack.imgur.com/uZVhV.png) Some context: this is a plot I want to make to show how much influence is exerted (y values) on certain policy positions (x values). The first elements are actors. So Actor 1 exerts 611 influence on policy position 6 (first bracket 0-10). For each bracket I want to visually see how much influence is exerted by the actors and how this looked stacked


The same analytical expression gets inconsistent FourierTransform results

I have an expression which is just a linear combination of plane waves, and I'd like to calculate FT of it. I know what I will get should be a bunch of delta functions, but it turns out _Mathematica_ gives me a completely wrong result:               FourierTransform[(E^(-I (k1 + k2) (x1 + x2)) (E^(I (k2 x1 + k1 x2)) +          E^(I (k1 x1 + k2 x2))))/(4 \[Pi] (I + 2 k1 - 2 w) (-I - 2 k2 + 2 w)),          {x1, x2}, {p1, p2}]      > 0 However, if I re-organize the numerator of this expression to a simpler form of plane waves               E^(-I (k1 + k2) (x1 + x2)) (E^(I (k2 x1 + k1 x2)) + E^(I (k1 x1 + k2 x2))) // ExpandAll      > E^(-I k2 x1-I k1 x2)+E^(-I k1 x1-I k2 x2) and then insert the above expression back to the numerator, after `FourierTransform` I get the correct result:               FourierTransform[(E^(-I k2 x1 - I k1 x2) + E^(-I k1 x1 - I k2 x2))/                  (4 \[Pi] (I + 2 k1 - 2 w) (-I - 2 k2 + 2 w)), {x1, x2}, {p1, p2}]       > (DiracDelta[-k2+p1] DiracDelta[-k1+p2])/(2 (I+2 k1-2 w) (-I-2 k2+2 > w))+(DiracDelta[-k1+p1] DiracDelta[-k2+p2])/(2 (I+2 k1-2 w) (-I-2 k2+2 w)) So the question is: is it a bug or what?


Solving for $d$ in $x= E^d mod(n)$

With regards to Public Key Cryptography, I have been tasked with the problem of attacking some information given in an assignment and discovered a private key used to digitally sign a message. Known: b=6457627465447259726545623456572345278769729879898923141341234834576924 E=636639191847512969815095201268921757340802323904442331816314803438352146049271931476368280851309606530687971170887811 e=28392183987218362187611 n=2586209689424400825455988397587474553299674868150931056740574331530510902486656504548725769127921248580701626507593549 x=(b^e)* E mod n x=2247676102207626815073883524633387712906791776446694001817826764472164534453199201306883083874653906533041962112997091 z=1073329998123424673279340351490160754917466285560207441443387824222426450994108105554368670865577655836728118040 The problem scenario is as follows: Alice computes her RSA public key, given by n. Her encryption exponent is e. Nancy sent an encrypted email that is contained in E. Bob wants to know what the message is, so he sends a phony email to Alice asking her to digitally sign it. He picks number b, computes (b^e)*E mod n, and then asks Alice to sign it. From this signing of his number, you are then able to derive the private key Alice used to sign the message. Message Signing: x ≡ E^d mod n Message Signature Check: x^e ≡ E mod n To find d, it must be solved for in the following equation: Z= x ≡ E^d mod n where Z,x,E,n are known How do I determine what d is?


Infix strange behaviour

Maybe this is a bug or maybe Infix acts differently than the other functions. The fact is that both:               TreeForm[Infix[f[x, a]]]      and               ToString[Infix[f[x, a]]]      crash the kernel. I use Mathematica 9.0 and maybe there are other cases that Infix behaves strangely. Does anybody can explain why this happens ?


Speed improvement in string distance function

I'm using this distance function to compare distance between strings:               distance[str1_String,str2_String] := Module[{split,r},         split="*"<>#<>"*"&/@StringSplit@str1;         r=N@Total[Boole@StringMatchQ[str2,#,IgnoreCase-> True]&/@split]/Length@split         ]     totalDistance[str1_String,str2_String]:=(distance[str1,str2]+distance[str2,str1])/2      `totalDistance` works just nice, but it's one order of magnitude slower than native distance functions like `EditDistance`. Here is some code test:               testList=ConstantArray["Distance String Test with Mathematica",50000];     totalDistance["String distance test with MMA",#]&/@testList//AbsoluteTiming//First     EditDistance["String distance test with MMA",#]&/@testList//AbsoluteTiming//First      > 4.063474 > > 0.433012 Some clue on how to optimize this code?


Why is Text in an Image cut off?

I want to create a long, skinny `Image` containing only text. This makes a square image of the default size.               Image@Graphics[      {       FontSize->20,       Text["now is the time for all good men to come to the aid of their country"]      }     ]      ![enter image description here](http://i.stack.imgur.com/ANRhV.png) So I prescribe the dimensions I want:               Image@Graphics[      {       FontSize->20,       Text["now is the time for all good men to come to the aid of their country"]      },      ImageSize->{1000,30}     ]      ![enter image description here](http://i.stack.imgur.com/t0CP5.png) and the result is cropped well inside the `ImageSize` so some of the text is missing. But the `Graphics` alone is appearing correctly.               Graphics[      {       FontSize->20,       Text["now is the time for all good men to come to the aid of their country"]      },      ImageSize->{1000,30}     ]      ![enter image description here](http://i.stack.imgur.com/2WAaJ.png) Why does `Image` mysteriously crop the input?


What is the right way to construct DynamicModule

When I'm creating `DynamicModule`s for CDF purposes I'm usualy basing on my experience with that, particular goal and content rather than on deep insight. **I want to ask for advice what is a good place for definitions of rather non- dynamic parts of the code. More precise question is at the end so you can scroll down and come back later :)** I'm going to show couple of ways, their advantages and disadvantages. ## Initialization :>               DynamicModule[{}, st1@"title"                   , Initialization :> (st1 = Style[#, Bold] &)]      > >     st1["title"] >   Well, that's not what we want.   * I know I can use `Dynamic` but here and after we are assuming that the less inside `Dynamic` the better. There is no special need for it so I will not do this.   * Notice that we can `Shift`+`Enter` again and saving such `DynamicModule` will result in proper display of content. **Double evaluation** is the only inconveniece. ## scoped Initialization :>               DynamicModule[{st1}, st1@"title"                   , Initialization :> (st1 = Style[#, Bold] &)]      > >     st1$$["title"] >   It is natural one may want to scope this name but now it is not going to work even with double evaluation. ## Initialization ->               DynamicModule[{}, st2@"title"                   , Initialization -> (st2 = Style[#, Bold] &)                  ]      > >     title >   Whoah, `**->**` seems to be a solution... nope. Unfortunately I can't recall the example but I've faced a problem when I tried to switch `:>` to `->` once in the past. The CDF was build with `:>` and `->` broke it. Moreover, if we try to scope the name it is going to fail: ## scoped Initialization ->               DynamicModule[{st2}, st2@"title"                   , Initialization -> (st2 = Style[#, Bold] &)                  ]      > >     st2$$["title"] >   * * * ## Body of DynamicModule This is the way I'm using for defining static parts of the code. It works for scoped and unscoped names:               DynamicModule[{st2},                   st2 = Style[#, Bold] &;                   st2@"title"                  ]      > title   * However there is one issue discussed here. We can not use `SetDelayed` but we assumed it should be a static content so it doesnt matter (or at least I can't recall any counterexample).   * This is also not very convenient if there is a lot of static content one want to define. I like to have body skeleton on top so it is easy to manage the whole project easily. I'm afraid I can't have both. ;) * * * ## Outisde In case of static elements that are imidiately on top there is also a way to define them **outside`DynamicModule`**. FE is going to store them and such CDF will work. However not everything is on top at start. * * * ## Questions Main question is:   * Is the habit to define static content in `Body` and dynamic parts in `Initialization` the best approach? Secondary qestion:   * What is the difference between `->` and `:>` with `Initialization`, is one better from another? Documentation center says: > "The typical usage is `Initialization:>expr`." > but on the other hand `InputAutoReplacement` puts `Initialization->`.


Confidence level for Binomial

> For 617519 first time births there were 317528 boys. Give an estimate with > 99% confidence interval for the probability that the first time birth is a > boy. I have searched for the confidence interval function. However, I cannot find any match with probability and confidence interval within the `HypothesisTesting` package. The result I am looking for is:               (*0.51255,0.51583*)


Is it possible to enable syntax highlighting for \[Function]?

This is a bit of a long shot but I am wondering if it is possible to enable syntax highlighting in a function defined with `\\[Function]` without resorting to anything too heavy duty. For example I would like the `a` in the second line to be colored as it is in the first: ![enter image description here](http://i.stack.imgur.com/9S4FB.png) * * * This is apparently enabled out of the box in versions 8 and 9.


Speeding up Import and Export in CSV format

I am handling large numerical data in _Mathematica_. In smaller problems everything worked fine using `Export` and `Import` with the parameter `csv` and nothing more. Now I am facing a much larger data volume and plain `Export` and `Import` is way too slow for CSV format. What I want to do: First, exporting a numerical list of approximately $1400 \cdot 260$. Then I perform some calculations outside of mathematica and finally I import a csv file back using `Import`. In this question I read how to improve the speed of `Export` with CSV. I tried               Export["data.csv",        ExportString[Transpose[temp], "CSV", "FieldSeparators" -> ", "],        "Table"];      for a toy-example of dimension $9 \cdot 6$. This could be               temp = RandomReal[{0, 1000}, {9, 6}];      The problem is that I got additional blank lines in my CSV file. How can I avoid those blank lines? I did not have them using plain `Export`. Second part of the question: can I use a similar approach to speed up `Import` for CSV files? I work in English locale in Windows 7 and _Mathematica_ 8. My data should be comma-separated. The result of the above looks like this:               155.9418457227914,427.72566448956945,462.4370455183139,434.230107096781,377.73423736605037,457.7044624877774,229.5721937681028,453.6973831247924,827.5146478718962          656.9573702857699,975.1048399942904,716.715190156526,67.07781324817643,168.78248854317894,863.1953962590844,997.7580107302701,427.94798294100747,565.2955778916687          192.3648037459477,435.0418975785194,126.17228368369842,772.0737083559297,453.73573640921836,957.9178360741387,920.4158275934401,234.75353158374764,162.82606110943834          841.7132070637356,799.1268178998612,931.2448706410551,950.7753472229233,114.01596316796622,145.0771999411104,287.47149951303663,786.9008107323455,99.09420650484662          116.9916885502289,715.7594598282562,970.6252946068753,654.1742185278038,262.3778046629968,200.13980161337577,347.24862854841354,314.5612015073982,241.11046402342163          203.65015448763597,952.1236458849723,578.2673369638862,527.2990305555661,655.1228742370724,318.81372163827496,311.2738362265584,315.97629887850667,514.7676854642548      EDIT: A small example of the data that I want to import (2nd step) can be found here. The true problem size is here.


Select and plot real positive solutions for a sixth order parametric equation

I need your help in order to solve the following problem: I have a sixth order equation: $ax^6+bx^5+cx^4+dx^3+ex^2+fx+g=0$ and I solved it using `Solve[]` command, so I obtained 6 root objects. Now I would like to evaluate these solutions for different ranges of the equation coefficients (a between a1 and a2, b between b1 and b2, etc), selecting the only one real positive solution (that always exists for each coefficient combination) within the six, and then use the Manipulate command in order to plot the surface corresponding to these real positive solutions as function ofthe other parameters. Any help would be greatly appreciated. Some notes: I solved my Equation with this command line:               soldi = Solve[modqTomb - modqTomx == 0, di]      then I obtained my roots objects that are too long to post here. I then tried to plot the solution selecting only the real positive one with this line                   Plot3D[Select[Evaluate[di /. soldi] /. {csik -> 0.001},FreeQ[di /. #, Real] && (di /. #) > 0 &],{omegao, 50*2*Pi, 5000*2*Pi}, {psiqgamma, 1*10^-6, 3.38*10^8}]      But obviously it did not work. I also tryed too split the different command and a lot of other combination but no one seems to work. I'm sorry but I am a new userof Mathematica. **ADDITIONAL INFORMATION** I defined                omegab = \[Sqrt]((2*(omegao^2 + psiqgamma) +Sqrt[(2*psiqgamma*(psiqgamma+omegaao^2))])/2);      omegap = \[Sqrt](omegao^2 + psiqgamma);         a = -omegab^2 + omegap^2;      b = 2*di*omegap*omegab;      c = omegab^4 - omegao^2*omegab^2 - 4*di*csik*omegao*omegap*omegab^2 -omegap^2*omegab^2 + omegao^2*omegap^2 - psiqgamma*omegab^2;      d = 2*omegab*(-csik*omegao*omegab^2 - di*omegap*omegab^2 +di*omegap*omegao^2 + csik*omegao*omegap^2 + psiqgamma*di*omegap);      modqTomb = ((a*c + b*d)^2 + (c*b - a*d)^2)/(c^2 + d^2)^2;      modqTomx = (4*di^2)/(-4*di*csik*omegao*omegap - psiqgamma)^2;      soldi = Solve[modqTomb - modqTomx == 0, di]      I would like to plot the surface of the real solution as function of the parameters: omegao, csik and psiqgamma (for each triplet I obtain 6 roots of which 1 is positive)


Prenex and Skolem normal forms

In MMA version 7 there was a big advance in logic support ("Boolean computations" is the official name). This was not further developed in version 8.0. So now we have a fairly robust support for propositional calculus, but not too much for predicate calculus. To this end, it would help a lot if we had an internal function capable of transforming a formula (logic formula, I mean) into the Prenex normal form or, even better, into a Skolem normal form. Is anybody aware of a 3rd party package which addresses this problem?


Customizing decimal mark used in plot frame tick labels

I am using the `Plot` function in a usual way. I use Mathematica 9.0.1.0 in English (I do not know if it is available in other languages, but I do not mind), and as a result of that, the numbers that appear in the frame tick labels use _dots_ as decimal markers. I need all numbers in the plot to be shown with a _comma_ as a decimal marker. Is that possible? Here you have a MWE —nothing special:               Plot[Sin[x], {x, 0, 10}, PlotRange -> Automatic, Frame -> True,       Axes -> False, AspectRatio -> 1/GoldenRatio, ImageSize -> 600,       Frame -> True, FrameTicks -> Automatic,       LabelStyle -> Directive[FontFamily -> "Calibri", FontSize -> 12]]      This is what I get: ![Minimum Working Example](http://i.stack.imgur.com/dLrmP.png) This is a minor issue, as I can export the image and change its labels outside Mathematica, but in case I would like to do this inside Mathematica, how could I get it? ADDITIONAL INFORMATION: I've tried it by using `$Language = "Spanish"`, with no success.


How can I set Grid alignments using numbers?

There is an example in the `Alignment` documentation (it also appears in the `Grid` documentation):               Grid[{{Graphics[Rectangle[], ImageSize -> 20],         Graphics[Rectangle[], ImageSize -> 30]}, {Graphics[Rectangle[],          ImageSize -> 40], Graphics[Rectangle[], ImageSize -> 50]}},       Alignment -> {{Right, Left}, {Bottom, Top}}]      ![enter image description here](http://i.stack.imgur.com/fH8Dr.png) The `Alignment` documentation indicates that numbers can be used for the alignment. Therefore the example above should be able to be re-written as               Grid[{{Graphics[Rectangle[], ImageSize -> 20],         Graphics[Rectangle[], ImageSize -> 30]}, {Graphics[Rectangle[],          ImageSize -> 40], Graphics[Rectangle[], ImageSize -> 50]}},       Alignment -> {{1, -1}, {-1, 1}}]      However this has no effect: ![enter image description here](http://i.stack.imgur.com/70XD4.png) So what is the correct way to use numbers for `Alignment`?


How to evaluate only arguments, but leave topmost expression unevaluated?

I want to represent expressions mostly in unevaluated form, but being able to evaluate it's subparts. For example, how to evaluate only arguments, but leave topmost expression unevaluated? For example, so that               1 + Cos[0]      give               1 + 1      **UPDATE** I want Mathematica to act something like follows. If I write               <something> 1 + Cos[0]      it should respond with               <something> 1 + Cos[0]      i.e. having expression as is, unevaluated Then if I enter something               <something> 1 + Evaluate[Cos[0]]      it should respond with               <something> 1 + 1      I.e. I want to CONTROL evaluation, not allowing Mathematica to evaluate what it wants. Only what I want. Imagine gradual scholar math text where expression is converted gradually portion by portion and presented at intermediate stages. Since I don't know how it can be implemented, I am not describing this with much detail. It can be some combination of holding heads or some global modes turnable on and off. The goal is not to loose my work done while entering long expressions, which Mathematica tends to throw out by evaluating. The solution should not be complex like in referred answer, it should be some simple built-in feature.


Purpose of construct `With[{var=myComputation[...]}, var/;True]`?

Could someone please give an illustrative example showing the purpose of construct of form `With[{var=myComputation[...]}, var/;True]`? Also, I wonder what kind of reference material are available for getting familiar with programming idioms for Mathematica. I mean besides the basic syntax that one can learn and re-learn from standard documentation, there are repeated patterns that programmers use. Somewhat similar to design patterns and "proramming pearls" for Java.


How to inject an evaluated expression into a held expression?

I know that there are methods to structurally manipulate held expressions (discussed e.g. here), but I failed to apply those for this particular problem:               (Hold[{3, 4, 5 | 6}] /. (Verbatim@Alternatives)[x__] :> RandomChoice@List@x)      > >     Hold[{3, 4, RandomChoice[{5, 6}]}] >   The code should replace any `Alternatives` in the held expression with an appropriate choice from the alternatives, in this case either 5 or 6, i.e. it _should_ evaluate the replacement.


Replace inside Held expression

I wish to make functional replacement inside `Held` expression like this:               f[x_Real] := x^2;     Hold[{2., 3.}] /. n_Real :> f[n]     => Hold[{4., 9.}]      But I get `Hold[{f[2.], f[3.]}]` instead. What is the best way to make such replacement without evaluation of the `Held` expression?


Efficiently collecting results inside a compiled function

When we don't know the number of results that will be generated, the usual way to collect results is `Reap`/`Sow`. Another alternative is linked lists. Neither of these are available in compiled functions. `AppendTo` does work, but it has an $O(n^2)$ complexity, so it will be unacceptably slow for long result lists. There was a very clever suggestion to use `Internal`Bag` in these situations:   * Internal`Bag inside Compile Unfortunately a compiled `Bag` will only hold scalars. Let's try to use vectors:               cf = Compile[{},        Module[{bag = Internal`Bag[{{0, 0, 0}}]},         Do[Internal`StuffBag[bag, {i, i, i}], {i, {1, 2, 3}}];         Internal`BagPart[bag, All]       ]]      `CompilePrint` shows that this calls `MainEvaluate`, so this does not work. **What is the best way to collect a large number of results in a compiled function when the number of results is not known before the computation and the result type is not a (fixed size) vector or matrix?** * * * ### Benchmarking the answers   * **Andy's answer**              cf = Compile[{len},            Module[{bag = Internal`Bag[Most[{0}]]},               Do[Internal`StuffBag[bag, {i, i, i}, 1], {i, len}];              Partition[Internal`BagPart[bag, All], 3]            ]          ];          Do[cf[500000], {100}]; // Timing          (* ==> {2.87, Null} *)      I needed to initialize the `Bag` using `bag = Internal`Bag[Most[{0}]]` to let `Compile` know that it is holding integers, not reals (see here).   * **Leonid's answer**              cf2 =        Compile[{len},        Module[{arr, lim, ctr},         arr = ConstantArray[{0, 0, 0}, 10];         lim = Length[arr];         ctr = 1;         Do[          If[ctr == lim,           arr = Join[arr, Table[{0, 0, 0}, {lim}]];           lim = Length[arr]];          arr[[ctr++]] = {i, i, i},               {i, len}         ];         Take[arr, ctr - 1]        ]       ];          Do[cf2[500000], {100}]; // Timing          (* ==> {16.474, Null} *)      Comparing the computational complexity of the two solutions by direct measurement:               data = Table[        {Round[2^k], First@AbsoluteTiming@Do[cf[Round[2^k]], {100}]},         {k, 13, 19, 1/2}];     data2 = Table[        {Round[2^k], First@AbsoluteTiming@Do[cf2[Round[2^k]], {100}]},         {k, 13, 19, 1/2}];          ListLogLogPlot[{data, data2}]      ![Mathematica graphics](http://i.stack.imgur.com/5oFkN.png) (They're the same.)


what is the command to make Mathematica beep each time there is an error even for the same command?

sorry for a basic question, but does any one know what is the trick to make the front end beep at me each time I issue the same command (which contain an error)? It now only beeps the first time, but when I SHIFT+ENTER the same command again, it stops beeping. I want it to beep each time. here is an example:               expr = 0.09 - (0.00043739999999999995*          Sin[x])/(Sqrt[1 - 0.36*Sin[x]^2]*(0.0225 - 0.0081*Sin[x]^2))     FullSimplify[expr]      now it beeped and gave message to the notebook               Indeterminate      and the following messages to the console:                Mathematica beeped to let you know that a warning or error       message was generated by the kernel. You can disable this beep by resetting       MessageOptions in the Option Inspector.      But when I typed the above again:               FullSimplify[expr]      I see no more messages to the console and no more beeps but only the `Indeterminate` message comes out to the notebook. Only way to see the error again and hear the beeps is to do `Remove["Global`*"]` and run everything again. Strange thing, is that this behaviour does not happen for everything. For example, if I type               Simplify[1/0]      I will see a new error a hear a new beep EACH time I execute the command. I have a feeling that the kernel is remembering things. But I do not want to clear everything each time. I am using 8.04, and this is a picture of my setup: ![enter image description here](http://i.stack.imgur.com/bEhuJ.png) and here is the messageOptions in the advanced setup ![enter image description here](http://i.stack.imgur.com/Tfhml.png) I tried to change the `MaxMessageCount` to 100 but no change. same for the `MessageCountRestTime`. thanks


Deriving least-squares equations in Mathematica

I define $Y = a + b*x + e$, and I want to find values for $a,b,$ by least squares, so I minimize $RSS = sum((Y_i - a - b*x_i)^2)$ I then take derivatives, ${d RSS \over da} = 0$ and ${d RSS \over db} = 0$ and solve. Now if I put these formulas into _Mathematica_ ,               f2[a_, b_, y_, x_, n_] = Sum[(y[i] - a - b*x[i])^2, {i, n}]           Solve[{D[f2[a, b, y, x, n], {a}] == 0, D[f2[a, b, y, x, n], {b}] == 0}, {a, b}]      I get the following error. > Solve::nsmet: This system cannot be solved with the methods available to > Solve. The derivatives work, but _Mathematica_ doesn't know how to expand out the summations. Any thoughts? I've tried `Expand`, `Sum`, `Distribute` (as suggested in some different expanding `Sum` questions). I've also seen some thoughts on how to define _Mathematica_ rules for summations (anyone have those?).


How can I work out which functions work with SetOptions?

Not all functions seem to work with `SetOptions`. e.g.               SetOptions[Grid, BaseStyle -> Directive[Red]];     Grid[{{"hello", "world"}}]          hello world      the font _is not_ red.               SetOptions[Row, BaseStyle -> Directive[Red]];     Row[{"hello", "world"}]          hello world      ...and the font _is_ red. ![enter image description here](http://i.stack.imgur.com/TWDM4.png)               SetOptions[InputField, FieldSize -> 5];     InputField[Dynamic[x]]      the input field size is _much_ larger than 5. But on the other hand               InputField[Dynamic[x], Sequence @@ Options[InputField]]      yields an input field with field size 5. ![enter image description here](http://i.stack.imgur.com/XAS9x.png) ...and so on. What is the easiest way to work out (i.e. make a list of ...) which functions can't be used with `SetOptions`?


TeXForm and large brackets (\Biggl[ etc)

## Goal I am trying to export a very long expression like               expr = c1*bracket1[a+b+c2*bracket2[d+e+f...]]+...      to LaTeX using `TeXForm`. `bracket1[arg_]` should end up as `\Biggl\\{<arg>\Biggr\\}`, `bracket2[arg_]` as `\biggl<arg>\biggr]` and so on. ## What I have What I have managed so far is defining a format for `bracket1` and `bracket2` that adds text before and after the argument:               Format[bracket1[arg_]] := Row[{"beginbracket1",arg,"endbracket1"}]     Format[bracket2[arg_]] := Row[{"beginbracket2",arg,"endbracket2"}]      This renders `expr` (without the ellipsis) as               In[1]  := expr//TeXForm     Out[1] := \text{c1} \text{beginbracket1}a+b+\text{c2} \text{beginbracket2}d+e+f\text{endbracket2}\text{endbracket1}      ## What I have not / Questions   1. The above does not work if I include `TeXForm` in the `Format` definition. I think I read somewhere that the `TeXForm` is not distributed to the recursive calls of `Format` during formatting. The implementation above leads to `StandardForm` being cluttered by the strings as well. Is there a way to restrict this formatting to TeXForm?   2. What I could not achieve as well was outputting raw LaTeX commands:              Format[foo,TeXForm] := "\\foo"      produces              In[1]  := foo//TeXForm     Out[1] := "\text{$\backslash \backslash $foo}"      and using `[\Backslash]` instead of `\\\` only reduces the number of `$\backslash$` to one. Is there a way to define raw TeX commands? ## Remarks   * I would like to avoid using `\left` and `\right` because of the line breaks which are necessary due to the length of the expressions.   * I would be content with a solution which allows me use the different sizes of LaTeX brackets (and braces and parentheses) without the raw TeX commands. It would be nice to know whether raw TeX is possible at all though.


Get histogram of number of vertices per component of graph H

I have a huge graph with ~8k vertices and ~1k components. I want a histogram showing the number of vertices for each component. How do I do this? EDIT: I'm trying ubpdqn's approach, but not gettting the expected results. Here are the details of my graph and the resulting histogram:               H = ExampleData[{"NetworkGraph", "HighEnergyTheoryCollaborations"}]          Histogram[Length /@ ConnectedComponents[H], LabelingFunction -> Above, BaseStyle -> 20]      Result: ![enter image description here](http://i.stack.imgur.com/AnD2P.png)


Which Method option should I choose for NIntegrate in two dimensions?

I want to integrate an interpolating function `a[x,y]` over a certain region in the xy-plane. My problem is that _Mathematica_ is taking too long. I am hoping someone knows a method which will speed up the calculation. Here is my integration expression               NIntegrate[a[x, y], {x, -12, 12}, {y, -12, 12},        AccuracyGoal -> 8, PrecisionGoal -> 8, Method -> "LocalAdaptive"]      I chose "LocalAdaptive" because I read that it is usefull for integration in higher dimensions. And my interpolating function, `a[x,y]`, looks like this: ![enter link description here](http://i.stack.imgur.com/PM0GL.jpg)


Control over depth-first scan and breadth-first scan

Is there a way to **conditionally** take control/modify the flow during a depth-first scan or the breadth-first scan ? Say, **for example** , if a particular node if found, consider it as a leaf- node and continue with the rest of the processing as usual (meaning do not traverse its child-nodes).


Integrand evaluating to non-numerical values

I have solved a system of equations using NDSolve just fine. From there, I can plot the solutions $u(x)$ and $v(x)$, as well as its derivatives, just fine. But, when I want to evaluate the energy density for v, defined as $E(x)=\frac{\alpha}{2}(\frac{\partial v}{\partial x})^2+\beta((v^2-1)^2+\epsilon_2v)$, as well as the total energy, $\int_{0}^{10}E(x)dx$, I run into the following problem:               NIntegrate::inumr: "The integrand energiephi6 has evaluated to non-numerical values for all sampling points in the region with boundaries {{0,10}}."      Here's the code:               eps = 1/4;     eps2 = 1/10;     eps3 = 1/10;     alpha = 1;     beta = 3;     a = 5.6294;     sol = NDSolve[{D[u[x], x,        x] == -(6 u[x]^5 - (8 + 4 eps) u[x]^3 + (2 + 4 eps) u[           x] + (v[x]^4 - 2 v[x]^2 + eps2*v[x] + 1)*2 u[            x]/(u[x]^2 + eps3)^2),      alpha*D[v[x], x,         x] == -beta (4 v[x]^3 - 4 v[x] + eps2)/(u[x]^2 + eps3),      u[0] == 0, u'[0] == a, v[0] == 1, v'[0] == 0}, {u, v}, {x, 0, 10}];     phi6n = Evaluate[v[x]] /. sol     phi6Dn = D[phi6n, x]     energiephi6[x] = 0.5*alpha*phi6Dn[x]^2 + beta ((phi6n[x]^2 - 1)^2 + eps2*phi6n);     energietotale6 = NIntegrate[energiephi6, {x, 0, 10}]     Plot[Evaluate[u[t]] /. sol, {t, 0, 10}, PlotRange -> All]     Plot[phi6n, {x, 0, 10}, PlotRange -> All]     Plot[phi6Dn, {x, 0, 10}, PlotRange -> All]     Plot[energiephi6, {x, 0, 10}, PlotRange -> All]      Thus far, all I could do was to identify this line as the culprit:               energiephi6[x] = 0.5*alpha*phi6Dn[x]^2 + beta ((phi6n[x]^2 - 1)^2 + eps2*phi6n);


Scalar product of two vectors have the least value

In geometry 3D, let $A(1,2,-3) $ and $B(-1,4,1)$ are two points. In the plane $(P):2x-3y+3z-17=0$, find a point $M$ such that the scalar product of two vectors $AM$ and $BM$ will have the least value. How do I tell Mathematica to do that?


How to convert String to an Expression inside Manipulate which depends on control variable

Normally, in `Global` context, these 2 are equivalent               eqn = "r-x";     r = -2;     Plot[ToExpression[eqn], {x, -5, 5}]      and               eqn = r - x;     r = -2;     Plot[eqn, {x, -5, 5}]      But inside Manipulate (which is a `DynamicModule`) and assuming `r` is a control variable, then these are not equivalent. There is some context or scope change that is causing this which I do not fully understand. i.e. the following do not work the same way:               Manipulate[           eqn = "r-x";      Plot[ToExpression[eqn], {x, -5, 5}],      {{r, -1, "r"}, -2, 2, .1, Appearance -> "Labeled"},      TrackedSymbols :> {r}           ]      and               Manipulate[           eqn = r - x;      Plot[eqn, {x, -5, 5}],      {{r, -1, "r"}, -2, 2, .1, Appearance -> "Labeled"},      TrackedSymbols :> {r}           ]      The reason this would be useful, is that one can use an `InputField`, to enter an equation as a `String`, then convert it to an `Expression` and use it inside Manipulate, where the equation can have in it a variable which happens to be a control variable. Here is an example:               Manipulate[      Plot[ToExpression[eqn], {x, -5, 5}],      Grid[{        {"r=", Control[{{r, -1, ""}, -2, 2, .1, Appearance -> "Labeled"}]},        {"eqn", InputField[Dynamic[eqn], String], Dynamic[eqn]}        }],      {{r, -2}, None},      {{eqn, "r-x"}, None}      ]      ![enter image description here](http://i.stack.imgur.com/lrEaV.png) The idea is that one can enter an expression in the InputField with `r` in it, and then change `r` using the slider afterwords. The current solution to this is shown in this Prevent interdependence of controls but it is a work around and it helps if one understands better why the above example does not produce the same result when used inside Manipulate.


Creating a Network from a Output

So I used the locator pane to derive the positions of a vertex on a picture. The picture was the Maryland Power Grid and the vertices were the generators and loads of the power system. When I clicked the vertex and recorded it returned this (Vertex number {x-pos,y-pos}). After recording all the vertices I have a list of data and from this list I would like to graphically plot this network with their relative coordinates. From the output I would like to graphically create a minimum spanning network with the loads as either a certain color/shape and the generators as another distinct color and shape. From this I would like to run calculations such as Monte Carlo Simulations, create an adjacency matrix, and possibly even mess around with Markov Random Fields. I need help figuring out how to graphically represent it with color/shape distinctions between the loads and generators and produce a minimum spanning network from the output I received. The Input code was:               im= Import["http://esm.versar.com/pprp/ceir16/Images/Figure2_20.jpg"];     Module[{picturesize,i,bigger,imagesizes},     picturesize=675;     values={};     i=1;     imagesizes=ImageDimensions[im];bigger=1;     DynamicModule[{pt={0,0}},     If[imagesizes[[1]]<imagesizes[[2]], bigger=2];     TableForm@{         Button["Record!",AppendTo[values,{i,pt}];i++;],         LocatorPane[             Dynamic@pt,             Dynamic@Graphics[                 Join[                     {Inset[im,{0,0},{0,0},{1,1}]}                      ],             PlotRange->{{0,imagesizes[[1]]/imagesizes[[bigger]]},{0,imagesizes[[2]]/imagesizes[[bigger]]}},             ImageSize->picturesize]     ],     Dynamic[N@pt],     Dynamic[MatrixForm@values]     }]     ]      ![enter image description here](http://i.stack.imgur.com/hfqLA.jpg) The Output was:               ({       {1, {0.0996, 0.4195}},       {2, {0.1046, 0.392}},       {3, {0.1144, 0.468}},       {4, {0.1164, 0.4415}},       {5, {0.1432, 0.4455}},       {6, {0.1442, 0.376}},       {7, {0.147, 0.5085}},       {8, {0.16, 0.4965}},       {9, {0.1628, 0.5305}},       {10, {0.1708, 0.484}},       {11, {0.1776, 0.379}},       {12, {0.1836, 0.4335}},       {13, {0.1856, 0.408}},       {14, {0.1936, 0.4495}},       {15, {0.2034, 0.5295}},       {16, {0.1974, 0.3595}},       {17, {0.2122, 0.4395}},       {18, {0.2152, 0.4465}},       {19, {0.2252, 0.3555}},       {20, {0.229, 0.4415}},       {21, {0.2716, 0.3535}},       {22, {0.2952, 0.313}},       {23, {0.3258, 0.4265}},       {24, {0.3446, 0.475}},       {25, {0.3476, 0.4315}},       {26, {0.3536, 0.408}},       {27, {0.3584, 0.3545}},       {28, {0.3694, 0.3665}},       {29, {0.3732, 0.384}},       {30, {0.393, 0.3535}},       {31, {0.395, 0.4205}},       {32, {0.4028, 0.3625}},       {33, {0.4028, 0.378}},       {34, {0.4088, 0.3525}},       {35, {0.4108, 0.4345}},       {36, {0.4286, 0.4505}},       {37, {0.4336, 0.405}},       {38, {0.4434, 0.247}},       {39, {0.4542, 0.303}},       {40, {0.4532, 0.4415}},       {41, {0.4612, 0.3515}},       {42, {0.469, 0.3455}},       {43, {0.47, 0.3685}},       {44, {0.477, 0.391}},       {45, {0.4888, 0.31}},       {46, {0.4948, 0.3315}},       {47, {0.4958, 0.371}},       {48, {0.4986, 0.217}},       {49, {0.4918, 0.4375}},       {50, {0.5214, 0.376}},       {51, {0.5244, 0.3455}},       {52, {0.5284, 0.4315}},       {53, {0.5294, 0.457}},       {54, {0.5302, 0.471}},       {55, {0.5302, 0.2875}},       {56, {0.554, 0.243}},       {57, {0.554, 0.323}},       {58, {0.554, 0.299}},       {59, {0.559, 0.231}},       {60, {0.559, 0.2575}},       {61, {0.559, 0.2725}},       {62, {0.5628, 0.244}},       {63, {0.5668, 0.221}},       {64, {0.5668, 0.316}},       {65, {0.5708, 0.1755}},       {66, {0.5816, 0.2665}},       {67, {0.5836, 0.224}},       {68, {0.5916, 0.152}},       {69, {0.5806, 0.307}},       {70, {0.5826, 0.3365}},       {71, {0.5876, 0.32}},       {72, {0.5974, 0.242}},       {73, {0.5984, 0.2845}},       {74, {0.6044, 0.2865}},       {75, {0.5856, 0.397}},       {76, {0.5906, 0.3605}},       {77, {0.5916, 0.388}},       {78, {0.6014, 0.3385}},       {79, {0.6054, 0.388}},       {80, {0.6132, 0.299}},       {81, {0.6132, 0.2865}},       {82, {0.6142, 0.2745}},       {83, {0.6182, 0.375}},       {84, {0.6252, 0.245}},       {85, {0.6252, 0.3355}},       {86, {0.629, 0.3605}},       {87, {0.63, 0.371}},       {88, {0.63, 0.388}},       {89, {0.633, 0.474}},       {90, {0.635, 0.3535}},       {91, {0.641, 0.3525}},       {92, {0.639, 0.411}},       {93, {0.6438, 0.3585}},       {94, {0.6458, 0.4355}},       {95, {0.6488, 0.473}},       {96, {0.6548, 0.2695}},       {97, {0.6576, 0.38}},       {98, {0.6646, 0.4455}},       {99, {0.6736, 0.3685}},       {100, {0.6764, 0.4415}},       {101, {0.6774, 0.396}},       {102, {0.6902, 0.402}},       {103, {0.6932, 0.373}},       {104, {0.6962, 0.473}},       {105, {0.6972, 0.453}},       {106, {0.718, 0.389}},       {107, {0.7268, 0.292}},       {108, {0.7228, 0.4335}},       {109, {0.7288, 0.457}},       {110, {0.7426, 0.296}},       {111, {0.7406, 0.4235}},       {112, {0.7644, 0.295}},       {113, {0.7624, 0.457}},       {114, {0.7802, 0.4225}},       {115, {0.7802, 0.2855}},       {116, {0.7822, 0.3355}},       {117, {0.797, 0.4315}},       {118, {0.799, 0.4495}},       {119, {0.8028, 0.4415}},       {120, {0.8168, 0.1235}},       {121, {0.8088, 0.459}},       {122, {0.8226, 0.1045}},       {123, {0.8186, 0.3465}},       {124, {0.8168, 0.468}},       {125, {0.8286, 0.244}},       {126, {0.8256, 0.2825}},       {127, {0.8266, 0.329}},       {128, {0.8226, 0.38}},       {129, {0.8196, 0.4345}},       {130, {0.8394, 0.167}},       {131, {0.8532, 0.291}},       {132, {0.8602, 0.1245}},       {133, {0.8652, 0.1085}},       {134, {0.8898, 0.166}},       {135, {0.8938, 0.133}},       {136, {0.9164, 0.221}},       {137, {0.9244, 0.153}},       {138, {0.9284, 0.1845}},       {139, {0.1076, 0.4125}},       {140, {0.1224, 0.3445}},       {141, {0.15, 0.4205}},       {142, {0.4028, 0.4215}},       {143, {0.4642, 0.33}},       {144, {0.467, 0.3395}},       {145, {0.5362, 0.242}},       {146, {0.548, 0.2525}},       {147, {0.5638, 0.131}},       {148, {0.6102, 0.1775}},       {149, {0.629, 0.3435}},       {150, {0.64, 0.456}},       {151, {0.6458, 0.317}},       {152, {0.6488, 0.3535}},       {153, {0.6508, 0.385}},       {154, {0.6538, 0.3365}},       {155, {0.6636, 0.328}},       {156, {0.6626, 0.161}},       {157, {0.6764, 0.3555}},       {158, {0.6854, 0.456}},       {159, {0.7002, 0.465}},       {160, {0.708, 0.387}},       {161, {0.715, 0.4345}},       {162, {0.716, 0.2635}},       {163, {0.7812, 0.1815}},       {164, {0.8958, 0.1925}}      })      So finally got it to work:               graphicslist =        Table[Rectangle[mpg[[i, 2]] , mpg[[i, 2]] + {.005, .005}], {i, 1, Length@mpg}];       Graphics[graphicslist]      And it returned: ![enter image description here](http://i.stack.imgur.com/LsuXL.jpg) Now I want a way to get the minimum spanning tree and from there get the adjacency matrix. Any Ideas?


Calling a DLL with two inputs and one output

I need to call a DLL that requires two real number inputs to get one real output back. I can get one of the simple example uses of `DefineDLLFunction` to work, but I don't understand what the syntax would be for using two inputs. I am not familiar with C++, C#, Visual Basic, so if any of that is required I'll need to be spoon fed. The dll I'm trying to use is from Refprop. It provides real fluid property data. Here is what works in MATLAB:               temp=200;     p=1000;     fluid='methane';     rho=refpropm('D','T', temp, 'P',p,fluid)      This will return the density (D) for methane with a temperature (T) of 200 and pressure (P) of 1000. refpropm is the name of the dll.


Row and Column Headings for a Grid

It would be useful for me if I could write:               Grid[{{a, b}, {c, d}, {e, f}},       GridHeadings -> {{"r1", "r2", "r3"}, {"c1", "c2"}}]      just like               TableForm[{{a, b}, {c, d}, {e, f}},       TableHeadings -> {{"r1", "r2", "r3"}, {"c1", "c2"}}]      except that I don't want the two lines `TableForm` produces. How could I add this additional option to `Grid`?


Efficient matrix / array generation

What is the most efficient way of generating the following matrix? $\left( \begin{array}{ccccc} 1 & 0 & 1 & 0 & 1 & 0 & 1 & \dots\\ \frac{1}{2} & \frac{1}{2} & 0 & 0 & \frac{1}{2} & \frac{1}{2} & 0 & \dots\\ \frac{1}{3} & \frac{1}{3} & \frac{1}{3} & 0 & 0 & 0 & \frac{1}{3} & \dots\\ \frac{1}{4} & \frac{1}{4} & \frac{1}{4} & \frac{1}{4} & 0 & 0 & 0 & \dots\\ \frac{1}{5} & \frac{1}{5} & \frac{1}{5} & \frac{1}{5} & \frac{1}{5} & 0 & 0 & \dots\\ \frac{1}{6} & \frac{1}{6} & \frac{1}{6} & \frac{1}{6} & \frac{1}{6} & \frac{1}{6} & 0 & \dots\\ \frac{1}{7} & \frac{1}{7} & \frac{1}{7} & \frac{1}{7} & \frac{1}{7} & \frac{1}{7} & \frac{1}{7} & \dots\\ \vdots & \vdots & \vdots & \vdots & \vdots & \vdots & \vdots & \ddots\\ \end{array} \right)$ where the first line begins $\{1,0,1,0,1,0,1,0,1,0,1,0\dots\}$ The second: $\{\frac{1}{2},\frac{1}{2},0,0,\frac{1}{2},\frac{1}{2},0,0,\frac{1}{2},\frac{1}{2},0,0\dots\}$ The third: $\{\frac{1}{3},\frac{1}{3},\frac{1}{3},0,0,0,\frac{1}{3},\frac{1}{3},\frac{1}{3},0,0,0\dots\}$ and so on. My effort is               y = 14; m = 7;     Table[Take[Drop[Take[Flatten[ConstantArray[Flatten[Riffle[Array[0 &, {n, n}],      Array[1 &, {n, n}]]], y - n]], y], n], y - m]/n, {n, 1, m}] // MatrixForm      but calculates too many unnecessary terms.


What does Binomial return for non-integer arguments?

Mathematica returns values for non-integer arguments passed to `Binomial`. What is the definition of `Binomial` for such continuous arguments? Example:               Binomial[9, 2]     36     Binomial[9, 2.3212312]     49.801     Binomial[9, 3]     84


Defining a function as a sum of several Gaussians

I have a function that is a summation of several Gaussians. Working with a 1D Gaussian here, there are 3 variables for each Gaussian: `A`, `mx`, and `sigma`: $A \exp \left ( - \frac{\left ( x - mx \right )^{2}}{2 \times sigma^{2}} \right )$               A*Exp[-((x - mx)^2/(2 sigma^2))]      The number of Gaussians in the final function will be vary each time the function is called, so my question is: **What is the best way to define a function in Mathematica that can handle this variation, rather than hard- coding each Gaussian?** I was thinking along the lines of providing a list of `{A,mx,sigma}` to the function, so that if I want one Gaussian, I provide:               f[{{A,mx,sigma}}]      And if I want two Gaussians, I provide               f[{{A,mx,sigma},{A2,mx2,sigma2}}]      which would give:               A*Exp[-((x-mx)^2/(2sigma^2))] + A2*Exp[-((x-mx2)^2/(2sigma2^2))]      and so on. But I'm not at all sure how to design the function `f[]` to do this efficiently (for example, can it be done without a `For[]` loop? Can it be compiled in future if necessary?). Any help much appreciated - I did several searches on here and couldn't find anything, but I realise that might be because I'm not sure how to define my problem succinctly, so apologies if it has been asked before and I've missed it.


axis label and ticks alignment of ListPlot3D and Histogram3D

I have a question on axis label alignment of ListPlot3D and Histogram3D. These labels are not aligned with the axis of the view, but only horizontally. I have tried very hard to align them manually, but the method sucks and still the output lacks precision and neatness. I wonder if M 9.0.0 has this facility? If no, then please suggest some clean way which aligns through exact calculations. Thanks in advance.               ListPlot3D[Table[Sin[i + j^2], {i, 0, 3, 0.1}, {j, 0, 3, 0.1}],      AxesLabel-> {Xaxis, Yaxis}, PlotLabel -> Sin[i + j^2], PlotStyle -> Purple]          Histogram3D[RandomVariate[NormalDistribution[0, 1], {500, 2}],     AxesLabel ->{Xaxis, Yaxis}]      Image by P.Fonseca ![enter image description here](http://i.stack.imgur.com/NiCuL.gif)


Why is $ProcessorCount different than the selected number of cores in PBS?

By using `ParallelTable` and submitting my Mathematica code to a cluster, I noticed that it was enhancing the speed even when I selected a **single core** in a **single node** , comparing to the use of standard `Table`. Verifying the number of cores using `$ProcessorCount`, I got 16. For selecting the number of cores I have submitted a bash file in terminal (already logged in SSH) using               qsub -I run_inter.sh      The file "run_inter.sh" contains               #!/bin/sh     #PBS -l walltime=10:00:00          #PBS -q par32     #PBS -l nodes=1:ppn=1      where "par32" is a machine with 32GB of RAM. Is there any reason for Mathematica to ignore the specification of core number and use 16 anyway?


How to obtain all the distinct De Bruijn sequences?

In combinatorial mathematics, a $k$-ary De Bruijn sequence $B(k, n)$ of order $n$ is a cyclic sequence of a given alphabet $A$ with size $k$ for which every possible subsequence of length $n$ in $A$ appears as a sequence of consecutive characters exactly once. Each $B(k, n)$ has length $k^n$ and there are $\dfrac{(k!)^{k^{n-1}}}{k^n}$ distinct De Bruijn sequences. By using `DeBruijnGraph` and `FindEulerianCycle` should be possible to obtain all the distinct sequences. In the example below I should obtain 24 sequences ($k = 3$, $n = 2$). However, I get only three distinct sequences:               out=FindEulerianCycle[DeBruijnGraph[3, 1], 24];     (First /@ #) & /@ out      > {{1, 1, 2, 1, 3, 2, 2, 3, 3}, {2, 1, 1, 2, 2, 3, 1, 3, 3}, {3, 1, 1, 2, 1, > 3, 2, 2, 3}} How can I obtain all the distinct De Bruijn sequences?


Measures of association, Concordant and Discordant

I want to calculate concordant and discordant pairs on nx2 tables. * * *               |    Value1   |  Value2  |     |_____________|__________|     |    0.3434   | 1        |     |    0.2132   | 2        |     |    0.3      | 3.3245   |     |    0.6      | 0.12321  |     |    0.745234 | 523      |     |    4        | 0.2134   |     |    3        | 111      |     |    .        | .        |     |    .        | .        |     |    .        | .        |     |    .        | .        |     |    .        | .        |     |_____________|__________|      This is a n x 2 table. How can I calculate concordant and discordant pairs? I am sorry I can't find suitable question tag.


Raise systemwide keypress event

Is there a way to raise system-wide "keypress" events programmatically from within Mathematica? Say "Ctrl+C" or "Ctrl+V", which all other programs can recognize? This is an attempt to gain simple control/automation of other programs from within the Mathematica environment


Printing grouped cells

How can I print grouped cells with CellPrint ? The closest thing I have to what I want to do is this               CellPrint[CellGroup[{TextCell["i","Item"],ExpressionCell[Defer[x^2;],"Input"]},1]]      But the cells aren't grouped.


How to define a pure function with a Module?

I was not able to use a self defined (using Module and For loops) piecewise function to fit data. It seems that the problem is that I have to define a pure function. I would like to learn how to define pure functions in the following example using Modules and For loops. Please help. So let's consider a problem - we have some data, and a self defined piecewise function f[z] that goes exactly through all the data points. LinearModelFit fitting data with f[z] should return value parameter equal to 1. Disclaimer: it will return a constant instead (basically will not understand what is the f[z] provided and will use a constant to fit the data). However, in the second part of the following example I will define a function g[z] (which will be equal to f[z]) using Piecewise[] and it will work perfectly (LinearModeFit will return 1). **So, once again, I would like to write f[z] using Module and For loops so that it works in LinearModelFit the way g[z] does.**               x = Table[x + Random[], {x, 1, 5}];     y = 2 # + Random[] & /@ x;     data = Transpose@{x, y};      # Part 1: self defined function f[z]               fpiecewise[x_, xlist_, ylist_] := Module[{i = 1},        For[i = 1, i < Length[xlist], i++, If[x <= xlist[[i]], Break[]]];        Return[ylist[[i]]]        ];     f[z_] := fpiecewise[z, x, y];          LinearModelFit[data, f[z], z];      ListPlot[{{x, % /@ x} // Transpose, data}, Joined -> True]      ![Part1](http://i41.tinypic.com/2ykcg0j.png) # Part 2: Piecewise[] defined function g[z]               x1 = Join[{0.}, x];     g[z_] := Piecewise[       Table[{y[[i]], x1[[i]] < z <= x1[[i + 1]]}, {i, 1, Length[x]}]]     LinearModelFit[data, g[z], z];     ListPlot[{{x, % /@ x} // Transpose, data}, Joined -> True]      ![Part2](http://i44.tinypic.com/23vixvk.png)


How can I fill a curve in ParametricPlot3D?

I'd like to fill a curve in a `ParametricPlot3D` in the same way as I might with `ListPointPlot3D`; i.e.,               ListPointPlot3D[data, ColorFunction -> "Rainbow", Filling -> Bottom]      I obtained the data numerically, point-by-point, with MATLAB. I have found a parametric expression for $y$ ($y = f(x)$) and I have a function $F(x, y, z)$, but I want to plot $F$ only for the curve $y = f(x)$, i.e., the 3D surface is defined as               Plot3D[x^2 Sin[x] + y^2 Cos[y] - x y, {x, 0, 1}, {y, 0, 1}]      and I want to plot only the specific line of surface which satisfy $y = f(x) = x^2$ using               ParametricPlot3D[{x, x^2, x^2 Sin[x] + y^2 Cos[y] - x y /. y -> x^2}, {x, 0, 1}]      I'd like to add a filling, but I don't know how. When I type `Filling ->`, the _Mathematica_ code editor complains (the text becomes red).


How to Output Chi-Squared Statistics when using NonLinearModelFit

I am using NonLinearModelFit for some curve fitting and I was wondering if NLM is able to output chi-squared/leastsquared statistics from the best-fit parameters and confidence intervals. From my understanding, NLM uses a least squares algorithm to find the best parameters, so shouldn't there be an associated chi-squared value with the fit? To check that everything was working, I ran the test a thousand times and looked at the distribution of a certain parameter, alpha. Instead of finding a normal distribution however, I found a distribution with 2 peaks. To me, this indicates that: 1 the fitting function is messing up somehow, or 2, that it is choosing a local minimum and not searching for a better place. I have tried increasing the number of iterations so that the algorithm could possibly find a better local minimum, but that was not successful. So I currently think that the algorithm is getting caught up somewhere. So, I was hoping that I could check the chi-squared value for each iteration and see if some fits were better than others. My code is below:               AU = 149597871000;     G = 6.67428*10^-11;     GMsun = 1.32712442099*10^20;     GMjup = GMsun/1047.348644;     dela = 10^-10;     rJup = 5.2 AU;     lambda = AU;     precision = 25;     alphas = {};     Data[dist_] := {SetPrecision[dist, precision],         SetPrecision[         GMsun/dist^2 + (GMjup dist)/(dist^2 + rJup^2)^(3/2) +           RandomReal[NormalDistribution[]] dela, precision]};     Model[dist_, alpha_, jupiter_, sun_, lambda_] :=        SetPrecision[(G sun)/dist^2 (1 + alpha Exp[-dist/lambda]) + (         G jupiter dist)/(dist^2 + rJup^2)^(3/2), precision];     Do[      Dat = Table[Data[x], {x, AU, 100 AU, AU}];      NLM = NonlinearModelFit[        Dat, {Model[dist, alpha, jupiter, sun, lam]}, {{alpha,           10^-7}, {jupiter, GMjup/G}, {sun, GMsun/G}, {lam, 20*AU}}, dist,         Tolerance -> 10^-50, AccuracyGoal -> precision,         WorkingPrecision -> precision, MaxIterations -> 1000];        realAlpha = NLM["ParameterTableEntries"][[1]][[1]];      realLambda = NLM["ParameterTableEntries"][[4]][[1]];      realJupiter = NLM["ParameterTableEntries"][[2]][[1]];      realSun = NLM["ParameterTableEntries"][[3]][[1]];      alphas = Append[alphas, Abs[realAlpha]];      , {i, 1000}]      Here the list alphas contains 1000 best-fit alphas from 1000 artificially created data sets (Note: this takes a while to run). The problem is that almost 20% of the time it outputs alpha ~ 10^-3, which is much too large to make sense. Thank you!


Can I create a CDF from Mathematica 7?

I am almost sure I remember seeing an online tool on the Wolframs website for creating CDF's for _Mathematica_ users with version 7. Am I right? And if so, where can I find it?


How can I superimpose a set of points on a ContourPlot?

I am familiar with _Mathematica_ to a certain extent, but its subtleties still elude me. **Currently I am trying to solve the following problem:**   The function $f(x,y)$ is continuous. I know how to create a contourplot of it. I also have a list of points `{{x,y}, ...}` which I would like to insert into my contour plot. **Background:**   I am working on some genetic algorithms and would like to visualize how the population converges to the global optimum. This is why I would like to show the population (or at least the best candidate of each generation) in the contour plot. How could this be done?


How to store values indexed by integer partitions for fast access?

I have a huge list of values indexed by integer partitions. If I store them simply in a list, then, when I want to access the value corresponding to some particular integer partition, I have to find the index of the given partition in the list of all partitions before I can access the value. This is slow. Is there a way to optimize this? In my particular example, I have values indexed by pairs of partitions of the same integers. The first 4 levels look like this:               chars = {       {{1}},        {{1, 1}, {-1, 1}}, {{1, 1, 1}, {-1, 0, 2}, {1, -1, 1}},        {{1, 1, 1, 1, 1}, {-1, 0, -1, 1, 3}, {0, -1, 2, 0, 2}, {1, 0, -1, -1, 3},         {-1, 1, 1, -1, 1}}     }      Then to access a particular value, I use this function:               maxn = 4;     YDs = Array[IntegerPartitions[#] &, maxn];          findChar[y1_, y2_] := Module[{l1, l2, n1, n2, i1, j1},       l1 = Length[y1];       l2 = Length[y2];       n1 = Sum[y1[[i]], {i, l1}];       n2 = Sum[y2[[i]], {i, l2}];       If[n1 != n2, Return["ERROR"];];       i1 = Position[YDs[[n1]], y1, Heads -> False][[1, 1]];       j1 = Position[YDs[[n2]], y2, Heads -> False][[1, 1]];       Return[chars[[n1, i1, j1]]];     ];      This seems to be a pretty inefficient way, but I don't know how to do it more effectively in Mathematica.


Replace Do loop with Nest

a1 = {1, 2, 3, 4};     Do[a2 = DeleteCases[a1, x1];       Do[a3 = DeleteCases[a2, x2];        Do[a4 = DeleteCases[a3, x3];         Do[Sow@{x1, x2, x3, x4};          , {x4, a4}]         , {x3, a3}]        , {x2, a2}]       , {x1, a1}] // Reap // Last      I would like replace my code with `Nest`, I have tried this               a1 = {1, 2, 3, 4};     Nest[Table[{i, j}, {i, a1}, {j, DeleteCases[#, i]}]~Flatten~1 &, a1, 3]      but it worked incorrect.


Reduce a huge low-rank matrix

I have a huge square matrix, with a lot of zero columns and zero rows: $m=\left( \begin{array}{ccccccccc} 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 3 & 7 & 9 & 0 & 0 & 0 \\ 0 & 0 & 0 & 4 & 8 & 1 & 0 & 0 & 0 \\ 0 & 0 & 0 & 2 & 6 & 3 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 \\ \end{array} \right)$ In general, I don't know where the zero columns (and rows), but when $i$-th row is empty, then $i$-th column is is also zero. My question is: Is there any internal command to delete all zero columns and zero rows? My motivation for this question is: I want to evaluate the eigenvalues of this huge matrix, which is slow. If I can reduce the matrix efficiently, Eigenvalues[] can be sped up.


Manipulate syntax

I am trying to manipulate a plot of the Bernoulli roots as follows: ![enter image description here](http://i.stack.imgur.com/lNroQ.gif) The following code clearly is not going to work, but I have included it in an effort to illustrate my meaning.               sol = Solve[N[Table[BernoulliB[n, z], {n, 20, 20}] == 0, 10]];     Manipulate[ListPlot[{{Re@z, Im@z} /. sol}], {roots, 1, 100}]      It is the {n, 20, 20} that I think I am having the trouble with - the 20 is obviously the variable I would like to manipulate, and {n, roots, roots} was all I could think of doing. I am also unsure how to format the axes and point sizes so they remain constant throughout the manipulation.


Dynamic Updating CreateDialog Problem

In this code, one cannot close the dialog window:               {TogglerBar[Dynamic[x], Range[5]], Dynamic[x],  Dynamic[CreateDialog[x]]}      If I use `DynamicModule` this way, the dialog window will not pop up when it was closed and re-chosen some values.               {TogglerBar[Dynamic[y],Range[5]],Dynamic[y],DynamicModule[{y=y},CreateDialog[y]]}      So how to make the created dialog window could be closed and reopen when click to set different values by `TogglerBar`


How to generate characters by a function which works like the Esc + a + ESC               In[24]:= CharacterRange["a","z"]     Out[24]= {a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z}      How to batch convert them to Greek Letters just like that done by this way Esc + a + Esc ... something like this, a function works,               In[25]:= CharacterRange["\[Alpha]","\[Zeta]"]     Out[25]= {\[Alpha],\[Beta],\[Gamma],\[Delta],\[CurlyEpsilon],\[Zeta]}          EnglishToGreekRange["a", "z"]      Comes out               {\[Alpha],\[Beta],\[Chi]...}


Graphics3D: the box vertices do not coincide with triangle

I have drawn a triangle using `Line` graphics primitive and `Graphics3D` function:                Graphics3D[Line[{{1, 0, 0}, {0, 1, 0}, {0, 0, 1}, {1, 0, 0}}],       Axes -> False, Boxed -> True, AspectRatio -> 1]      ![enter image description here](http://i.stack.imgur.com/1TS7y.png) But in the shape I get, the vertices of triangle do not coincide with the vertices of the box, how can I solve this problem?