How to use Compile to efficiently apply a function to every element of a list

Let's say I have a list of random numbers;               list = Table[Random[], {100000}];      I want to apply a function `f` in every element of the list and take their sum. An obvious solution to that would be               Total[f[list]]      For the sake of clarity I am using here the following simple `f`:               f=#^2&;SetAttributes[f, Listable]      (Of course, the function `Power` is `Listable` by default               Do[Total[f[list]],{100}]//AbsoluteTiming      outputs `0.158` on my machine.) But as always I want the fastest routine I can get. So I used `Compile` to reduce the running time:               fc=Compile[{{list,_Real,1}},Total[f[list]]];      Testing with               Do[fc[list],{100}]//AbsoluteTiming       I got a worse result, namely `0.288`! `:-(` I tested again putting `f` by hand inside the compiled function:               fcfast=Compile[{{list,_Real,1}},Total[list^2]];     Do[fcfast[list], {100}] // AbsoluteTiming      Output was `0.054` and I was pleased! Why is this happening? How can I speed up my routines without having to put the function explicitly inside `Compile`? Sjoerd C. de Vries answered on the question Using Apply inside Compile tracing with `Needs["CompiledFunctionTools"]` and the function `CompilePrint` that explains the timing differences but I still don't know how to improve that. **Results after applying the best solution** : I am adding here my test results using for various implementations. I added `CompilationOptions -> {"InlineExternalDefinitions" -> True}` which answered my question. The list i used contained 1000000 random numbers , `f=#^2&` and the compiler used was the MinGW. ![enter image description here](http://i.stack.imgur.com/8ayOa.gif)


On drilling holes with minimal redundancy (and with colors!)

The old _Mathematica_ package `Graphics`Shapes`` featured the function `PerforatePolygons[]`, which drilled a hole in any `Polygon[]` primitive present in a `Graphics3D[]` object. One would usually use it on the output of `ParametricPlot3D[]` or `Polyhedron[]` from the `Graphics`Polyhedra`` package, like so: ![objects with holes](http://i.stack.imgur.com/q1qP0.png) Here is a slightly simplified implementation of `PerforatePolygons[]` which I used in generating the pictures above:               perforateaux[points_, ratio_] := Block[{test = TrueQ[First[points] == Last[points]],       center, q},         center = Mean[If[test, Most, Identity][points]]; q = 1 - 2 Boole[test];         MapThread[Polygon[Join[#1, Reverse[#2]]] &,           Partition[#, 2, 1, {1, q}] & /@ {points, (center + ratio (# - center)) & /@ points}]]          PerforatePolygons[shape_, ratio_: 0.5] :=       shape /. Polygon[p_] :> perforateaux[p, ratio]      (I elected to remove the additional `EdgeForm[]` directive in the original implementation so that the images clearly show what is going on with each polygon. A proper implementation would have it, of course.) Nowadays, both `PolyhedronData[]` and `ParametricPlot3D[]` return `GraphicsComplex[]` objects within `Graphics3D[]`. The big benefit of this new representation, among other things, is that it minimizes redundant storage; instead of having a point being stored on three or four `Polygon[]` primitives, all the points in the object are stored in the first component of `GraphicsComplex[]`, and the `Polygon[]` objects only need to store the index corresponding to the point they need. For instance, compare the output of `PolyhedronData["Tetrahedron", "Faces"]` and `Normal[PolyhedronData["Tetrahedron", "Faces"]]`. The problem with this efficient representation is that it no longer works nicely with polygon replacement rules like the one used by `PerforatePolygons[]`. Of course, there is the obvious solution of applying `Normal[]` to any `GraphicsComplex[]` object generated before applying `PerforatePolygons[]`, but you lose out on the storage efficiency afforded by `GraphicsComplex[]`. Here now is my question: > Is it possible to improve `PerforatePolygons[]` so that it works > on`GraphicsComplex[]` objects, with the output still retaining the > `GraphicsComplex[]` characteristic of storage with minimum redundancy? * * * If the question above is not sufficiently challenging for you, consider the following wrinkle. `Polygon[]` objects in _Mathematica_ are currently able to take a `VertexColors` option that sets how the things are colored, with proper color interpolation within the polygon. > Is it possible to implement a version of `PerforatePolygons[]` that does its > best to have the new polygons inherit the coloring used by the old polygons? As an example of what is expected: ![colored polygon, with and without hole](http://i.stack.imgur.com/3P5zD.png) The improved `PerforatePolygons[]` should be able to produce an image like the one on the right from the one on the left. For triangular polygons, simple bilinear interpolation works nicely, but how about more complicated polygon objects? Again, it is important that a `GraphicsComplex[]` object still be one after the perforation.


How to implement the second loop

Here I have a problem that probably needs two loops, but I am not sure how to implement them together. The code calculates `M` for various values of parameter `G`. Now I want to find `M` which crosses the real axis (Imaginary part is zero) for each `α1 = (1.1, 2.2)`. So the code is working fine and for example for `α1 = 1.1`, I got the curve which crosses the real axis, so I have one real solution (for chosen segment `G`), now I want to find these real points `M` for various `α1` and to plot `M[α1]`.                \[Alpha]1 = 1.1;      \[Nu] = 0.001;      Tt = 0;       poly = -g^2 + 0.25 x^4 - (Tt + \[Alpha]1^2) x^2 + 2 \[Alpha]1 g x +       I \[Nu] g - I \[Nu] \[Alpha]1 x + 1;           LM = {};      Do[Lroots = x /. NSolve[(poly /. {g -> G}) == 0, x];      res = 0;      Do[root = Lroots[[i]];      If[Im[root] >= 0, L1 = Drop[Lroots, {i}];      res = res + 1/(Times @@ (root - L1));];, {i, 1, Length[Lroots]}];      M = 1/((4*I*G^2)*res);       AppendTo[LM, M];, {G, 0.01, 1.5, 0.001}];                  a1 = Min@Select[Table[Im[LM[[i]]], {i, 1, Length[LM]}], Positive];        a2 = Max@Select[Table[Im[LM[[i]]], {i, 1, Length[LM]}], Negative];             b1 = Table[LM[[i]], {i, 1, Length[LM]}] - a1*I;        b2 = Table[LM[[i]], {i, 1, Length[LM]}] - a2*I;             c1 = Select[b1, Im[#] == 0 &][[1]];        c2 = Select[b2, Im[#] == 0 &][[1]];             d1=Re[(c1 + c2)/2]      The curve crosses the real axis, but just for `α1 = 1.1`; now I need to extract for various `α1 = 1.1, ..., 2.2`, all points which cross the real axis.                p1 = ListPlot[Table[{Re[LM[[i]]], Im[LM[[i]]]}, {i, 1, Length[LM]}],       PlotRange -> {{-1, 18}, {-10, 10}}]


What is the correct way to pattern match nested lists?

I have the following function:               f[lst_List /; MatchQ[lst, SOME PATTERN HERE]] :=        ({#[[1]] + #[[2]], #[[1]] - #[[2]]} &) /@ lst;      I want to match lists that are ordered pairs of reals: `{{0.1, 0.2}, {0.3, 0.4}}`, and so on. I tried the following pattern:               MatchQ[{{0.1, 0.2},{0.3, 0.4}}, _List[_List[_Real, _Real]]]      but this returned `False`. I know that:               MatchQ[{{0.1, 0.2},{0.3, 0.4}}, {__List}]      returns `True`, but this pattern is not sufficiently specific, since it also matches `{{}}`, among others. What is the correct way to construct the pattern I want?


Reproducing Derive's plot of $1 - x^2 - y^2$ in Mathematica

In Derive 6, if I plot $1 - x^2 - y^2 $, I get this: ![](http://i.stack.imgur.com/1zvQu.jpg) However in _Mathematica_ 8 I get this: ![](http://i.stack.imgur.com/7uzK7.jpg) I'm using `Plot3D[1 - x^2 - y^2,{x,-5,5},{y,-5,5}]` What should I do in _Mathematica_ in order to get Derive's result?


Plot graphs in different colors

I am generating a set of plots and exploring how changing a parameter affects the plot shape. I want each plot to be a different color, but the color rule i'm applying seems to only work for the last color in the list. what is wrong with my syntax?               Vmorse[x_] =      d*(Exp[-2 \[Alpha] (x - x0)] - 2 Exp[-\[Alpha] (x - x0)]);     morseSubsTest = {d -> 4.43, \[Alpha] -> {1.9, 1, 3}, x0 -> 1.13};           Plot[Vmorse[x] /. morseSubsTest, {x, 0, 5}, PlotRange -> {-5, 0.5},       PlotLabel -> "Morse Potential change alpha",       PlotStyle -> {Red, Green, Blue}]


Transform a list of functions to a composition

How do I apply a list of functions in a nested way? Example:               functionList = {f1,f2,f3}          RequiredCommand[functionList,Pi]      such that the required command returns               f3[f2[f1[Pi]]]      or f1[f2[f3[Pi]]] (reversing the order is easy) I'm searching for an efficient way.


NDSolve producing an overdetermined system

I am trying to build the initial model for an electro-mechanical system that I will be running in a for-loop for various inputs and parameters. Currently, the code is as follows:               Clear[sol, k, n, θ1, θ3, T, J2, J1, c, c2, em, τ, α];     sol = NDSolve[{       J1*θ1''[t] + n^2*k*θ1[t] == k*n*θ3[t] + T[t],        J2*θ3''[t] + c*θ3'[t] + k*θ3[t] == k*n*θ1[t] - μ*(θ3'[t])^2*Sign[θ3'[t]] - c2*(θ3'[t])^3,        τ*T'[t] + T[t] == α*em[t],        θ1[t] == θ3[t] == T[0] == 0, θ1'[t] == θ3'[t] == 0},        {θ1, θ3, em, T}, {t, 0, 100}];      When I run the code it is returning an overdetermined system. I believe it is a simple syntax error, but as of right now I'm at a loss for ideas. Any pointers would be great!


How can I extract the points from a ListSurfacePlot3D?

How can I get numerical output of ListSurfacePlot3D, i.e., a list of all the points, $(x,y,z)$ , used to construct the plot? Thanks to your help I now have a list of (x,y,z). But the new mesh is irregular, I need z-values on specific (x,y). In more detail: The original data (https://www.dropbox.com/s/q76qsrf8hl4li7g/6686.dat) is an array of 40 by 40, with > x = {0, 0.5, 1.0, ..., 19.5} and the same for y. Following user0501's suggestion the output is: > data = {{0., 8.73992, 14.8593}, {0., 8.38421, 15.075}, {0., 8.3125, > 15.1281}, {0., 8.22328, 15.1943}, {0., 7.77126, 15.5292}, {0., 7.31923, > 15.8642}, {0., 7.125, 16.0081},...} How can I get the result based on the same regular grid as the grid based on the input data? If you like, you can get the original data here:               data = Import["https://dl.dropbox.com/s/q76qsrf8hl4li7g/6686.dat"];     surf = ListSurfacePlot3D[data, MaxPlotPoints -> 5]      Again, thanks a lot for your help!! Harald


How can you use and convert Gauss-Krüger-Coordinates in Mathematica?

I am given geographic data in the form of Gauss-Krüger-Coordinates and would like to calculate distances with them and convert them to longitude/latitude coordinates in another system for plotting (e.g. WGS84). Gauss-Krüger-Coordinates are essentially like UTM-coordinates based upon a transversal Mercator projection where positions are indicated by a Right-value (East-value in UTM; y-coordinate in the geodetic coordinate system) and a High-value (North-value in UTM; x-coordinate int the geodetic coordinate system) Far from being an expert in geodesy the way I understand it Mathematica's geodetic functions allow entering coordinates as `GeoPosition`, as `GeoPositionENU` or as `GeoGridPosition`. `GeoGridPosition` essentially will reference to a position on a projection so probably should be the way the Gauss-Krüger-Coordinates are entered, but I am not so sure. Mathematica does not seem to know Gauss-Krüger-Projection (not listed among `GeoProjectionData[]`) and I do not know which parameters to use for Gauss- Krüger and how best to do this. Thus: How can I enter the Gauss-Krüger-Coordinates into Mathematica so they can be used for distance-calculations and conversions using Mathematica's geodetic functions?


Change position of mesh

I'm trying to plot a 3D graphic and I want to highlight the intersection between two graphics: a plane and a surface. I thought that `Meshfunction->{#3&}` was a good idea, but I realized that I can't change the position of the mesh! This is my code:               a = 0.5;     J = -3.00;          U[x_,y_,a_] := -(1-a)/Sqrt[(x-a)^2+y^2] - a/Sqrt[(x+1-a)^2+y^2] - 0.5*(x^2+y^2);     t=Table[       Show[         Plot3D[2*U[x,y,a], {x,-1.5,1.5}, {y,-1.5,1.5},                PlotRange -> {-2.7,-4.0}, Mesh -> 1, MeshFunctions -> {#3&},                 MeshStyle -> {Orange, Thick}, ClippingStyle->None,                PlotStyle -> Directive[Gray],                 AxesLabel -> {Style["x",Italic,20],Style["y",Italic,20],Style["J=2U(x,y,a)",Italic,20]}],         Plot3D[J-t, {x,-1.5,1.5}, {y,-1.5,1.5},                 Mesh -> False, PlotStyle -> Directive[Green,Opacity[0.5]]],         ImageSize->700],        {t, 0., .7, .2}]      Someone can help me please?


Defining and Solving Systems of Equations Using Matrix Tables

I've defined a system of equations, but I been unable to get Mathematica to solve for the individual variables created by matrix tables.               Table[tair[j,i],{j,y},{i,x}]==c*Table[Sum[t[j,i],{j,j+1,y}]-Sum[tair[j, i],{j,j+1,y}],{j,y},{i,x}]          Table[tout[i],{i,x}]==c*Table[Sum[t[j,i],{j,1,y}]-Sum[tair[j,i],{j,1,y}],{i, x}]          tout[1]=16     tout[2]=16     tair[2,1]=0     tair[2,2]=0      C is a known constant. To confirm my math, I've used values of 2 for y and x and I've written out the 6 resulting equations in Mathematica, defining variables explicitly rather than through tables:               tair11,tair12,tair21,tair22,t11,t12,t21,t22,tout1,tout2      Using the Solve function, I get the right answer. But since I want to be able to increase the order of y and x to say, 100, a manual enumeration process is not practicable. My question: what must I do syntactically to get Mathematica to solve for these variables? Even a simple example not related to my code would be most helpful.


Op-art Graphic Images

This image comes from Michael Trott's Mathematica Guidebook for Programming. It's just a chapter image though, and he doesn't show the code. I was wondering what would be the best approach to reproduce it. ![enter image description here](http://i.stack.imgur.com/WiGct.jpg)


Is it possible to use PropertyValue to modify properties of Graph objects in a list?

This post can be seen as a follow up to Property assignment on a graph vertex using PropertyValue does not work inside a function. I have defined a function:               Clear[AddStone];     SetAttributes[AddStone, HoldFirst];     AddStone[board_, v_, s : (white | black | empty)] := (PropertyValue[{board, v}, VertexState] = s)      This function should change the VertexState property of vertex `v` in a graph `board` to one of `white`, `black`, or `empty`. It works as expected (credits to @Heike), as the execution of:                board = GridGraph[{5, 5}];           AddStone[board, 8, white]           PropertyValue[{board, 8}, VertexState]      demonstrates. But now suppose that I need to change the property `VertexState` of vertices of Graphs in a list. For example:                list = {CycleGraph[5], KaryTree[8]}      The following code doesn't work as expected:                AddStone[list[[1]], 3, white]      It returns the error: > Set::setraw: "Cannot assign to raw object > PropertyValue[{list[[1]],3},VertexState]=white." From the discussion here, I have an idea of why this happens (though a clear explanation would be appreciated). So I need an alternative way to change the properties of the graphs in a list, when all I have is the list (instead of references to the graphs themselves). I know I could apply `SetProperty` to the list and obtain a new list of graphs with the updated properties, but `SetProperty` is slower than `PropertyValue` because it creates a new copy of the graph with the property changed instead of modifying the original graph. Summing up, here is my **question** : Is there a way to use `PropertyValue` to modify the properties of graphs in a list?


How can I set the view vector in a 3D scene by tracking my face's position?

Faking 3D with 2D tracking data is something that I've long wanted to implement for use with my front facing laptop camera. A first step to solving this would be dynamically setting the viewpoint according to the movement of your head. **Edit:** To clarify, I'm looking for an answer like the code I'm giving below. The reason I ask is because there were a number of problems with my own solution:   1. The method used is not sensitive enough   2. It is far too slow   3. Not robust to background movement So a real answer to this question might use some fancy bit of machine vision, or interface with opencv face tracking libraries, or something else entirely. Here is a video of this technique applied sucessfully: http://www.youtube.com/watch?v=7saRtCUgbNI               ClusterMean[x_, 0, _] := Mean[x];     ClusterMean[{x_}, n_, frac_] := x;     ClusterMean[x_, n_, frac_] :=        With[{m = Mean[x], sd = StandardDeviation[x]},         With[{x2 = Select[x, Norm[Norm[# - m]/sd] < frac &]},          If[x2 == {}, Mean[x], ClusterMean[x2, n - 1, frac]]]];     $ytrim = $xtrim = {1, All};     SmallCurrentImage[] := ImageTake[CurrentImage[], $ytrim, $xtrim];          $first = SmallCurrentImage[];          FaceOffset[center : {_, _}] :=           Module[{mean, img1, img2, matches}, mean = {0, 0};       img1 = $first;           $currentimage = img2 = SmallCurrentImage[];       $matches = matches = ImageCorrespondingPoints[img1, img2];       mean = MapThread[Subtract, matches];            If[mean == {}, center, ClusterMean[mean, 1, 0.8]]       ]          center = {0, 0}; center2 = {0, 0}; $first = SmallCurrentImage[];          Dynamic[      If[CurrentValue["MouseOver"], center = FaceOffset[center];       center2 = center2*0.5 + center*0.5;];           Refresh[       Labeled[        Refresh[         Graphics3D[{PolyhedronData["RhombicHexecontahedron",             "Faces"]},           ViewPoint ->            Refresh[5*Normalize[Prepend[-center2/80, -1]],             TrackedSymbols :> {center}], SphericalRegion -> True,           RotationAction -> "Clip"],          None], {Show[$currentimage,               Graphics[{Red, MapThread[Line[{#1, #2}] &, $matches]}]],              Button["Reset View", ($first = SmallCurrentImage[];            center2 = {0, 0};), Appearance -> "Palette",           ImageSize -> Automatic]}, {Left, {Bottom, Right}}],        TrackedSymbols :> {center}]]


Cissoid of Diocles not smooth plotted by ContourPlot

Table[ContourPlot[y^2 (10-x)==x^3,{x,0,.1},{y,-.1,.1},PlotPoints->5],{k,1,150,10}]      ![enter image description here](http://i.stack.imgur.com/bcueX.png) How to get the smooth graph? When `PlotPoints` is larger than 500, performance is too slow, however still not good. ![enter image description here](http://i.stack.imgur.com/1jCCD.png) ![enter image description here](http://i.stack.imgur.com/LA7xI.png)


Mathematica envelope for the bottom of a plot, a generic function

I have the following set-up: > xaxis = Table[x, {x, 0, 10, 0.01}]; > > yaxis = Table [Sin[x] + Abs[RandomReal[{-1, 1}]], {x, 0, 10, 0.01}]; > > ListLinePlot[Transpose[{ xaxis, yaxis}]] ![enter image description here](http://i.stack.imgur.com/3v921.png) My questions is how can I make a line that very simply envelopes the function coming up from the bottom. **The envelope coming up from the bottom should be jagged such that it is a tight-fit (or overfitted).** Perhaps this could be controlled by some sort of smoothing parameter where 1: very jagged, 10: very smooth. The figure below shows a plot generated from the underlying function itself which obviously results in a very smooth fit. ![enter image description here](http://i.stack.imgur.com/FNupO.png)


Is there a way to get AbsoluteTime to correctly report absolute time differences?

Absolute time supposedly reports the "total number of seconds" between two dates, but it does not. For example because of the leap second applied at 2012-06-30T23:59:60Z               AbsoluteTime[{2012, 7, 1}] - AbsoluteTime[{2012, 6, 29}]      should be `172,801`, but it is `172,800`. In fact, _Mathematica_ seems to ignore leap seconds altogether:               DateList[{2012, 6, 30, 23, 59, 60.5}, TimeZone -> 0]      produces `{2012, 7, 1, 5, 0, 0.5}` when it should produce `{2012, 6, 30, 23, 59, 60.5}`. Am I missing something here? How are calculations and functions, such as `AstronomicalData` that depend on accurate time specifications supposed to work? * * * _Update_ : This remains the case in version 9.0.


Parallel PowerMod

Is there anyway to parallelize the `PowerMod` function? Here is my Left-To-Right modular exponentation:               AfshinPowerMod[a_, b_, m_] := (Output = 1;        Do[If[n == 1, Output = Mod[Output*Output*a, m],          Output = PowerMod[Output, 2, m]], {n, IntegerDigits[b, 2]}];        Return[Output])      It computes roughly in the same time as original `PowerMod` for 10K digits numbers. **Update** _(Since for prime testing, 2 is the lowest base, I've used it for faster computation)_ Timing Result (Mathematica 8):               In[1]:= Total[DigitCount[2^100000 + 1]]          Out[1]= 30103               In[2]:= AbsoluteTiming[AfshinPowerMod[2, 2^100000 + 1, 2^100000 + 1]]          Out[2]= {91.839778,}               In[3]:= AbsoluteTiming[PowerMod[2, 2^100000 + 1, 2^100000 + 1]]          Out[3]= {92.9851312,}      As per J.M. request for **RandomPrime** (Based on the generated random prime timing differs, but yet it is roughly as fast as `PowerMod`)               In[41]:= prime = RandomPrime[10^2000]               In[43]:= AbsoluteTiming[PowerMod[2, prime, prime]]          Out[43]= {0.1406312, 2}          In[42]:= AbsoluteTiming[AfshinPowerMod[2, prime, prime]]          Out[42]= {0.1562399, 2}


How to enumerate all possible binary associations?

Suppose I have a list of symbols like:               {a,b,c,d}      I would like to enumerate all possible binary associations (combining symbols and/or sublists pairwise):               {{{a,b},c},d}     {{a,b},{c,d}}     {a,{b,{c,d}}}     {{a,{b,c}},d}     {a,{{b,c},d}}      There should be altogether 5 solutions for this example. My question is how can I enumerate all such associations for a generic list? I have tried               ReplaceList[{a,b,c,d},{u___,v_,w_,x___}:>{u,{v,w},x}]      But this only works for the first layer.


Adding noise to nonlinear control system using NDSolve

I have a nonlinear control system               system = {x'[t] == u[t] m[t],       WhenEvent[And[Mod[t, 9], x[t] < 100], m[t] -> x[t]],       WhenEvent[u[t] == 0, m[t] -> 10],  x[t /; t <= 0] == 0,       m[t /; t <= 0] == 1, u[t /; t <= 0] == 0};          control = {e[t] == xref - x[t],       WhenEvent[Mod[t, \[Tau]],       u[t] -> kp (k1 Sign[e[t]] - k2 Sign[e'[t]])],       e[t /; t <= 0] == xref};      params = {kp -> 1, td -> 1, \[Tau] -> 0.5, xref -> 810, k1 -> 11/2, k2 -> 9/2};      which I simulate using `NDSolve`                sol = NDSolve[{system, control} /. params, {x, m, u}, {t, 0, 60},        DiscreteVariables -> {u, m}];      I would like to add random noise to the system, but so far nothing seems to work. Using `RandomReal[NormalDistribution[]]` is problematic, as it only samples once for `NDSolve`. Using `WienerProcess` with `ItoProcess` also does not seem to work, as the system contains discrete variables. I cannot convert it to a state space model, as `StateSpaceModel` only works for linear systems.


Animating arrows

I have the following Code:               No={{1, 2}, {1}};     arrows={{{{0, 0}, {1, 2}}, {{1, 0}, {2, 2}}, {{3, 4}, {1, 1}}}, {{{0, 0}, {1,      3}}}};     colors={Blue,Blue,Blue};     Animate[Graphics[{Sequence @@ {colors[[#]],         Arrow @@ (arrows[[t]][[#]])} & /@ No[[t]]},      PlotRange -> {{0, 2}, {0, 3}}], {t, Range[1, 2]}]      This does not seem work. It should display 3 arrows at time step 1 and only 1 at t=2... Do you have an idea?


Multivariate Polynomial Manipulation

I have a large homogenous multivariate polynomial in, say, 5 variables $a,b,c,d,e$. As an example take the polynomial $$a^4+2abcd+a^2 b^2+e^4+cde^2.$$ Now I would like to replace $k$-th power of any variable by $c_k$, so the above example would become $$c_4+2c_1^4+c_2^2+c_4+c_1^2c_2.$$ At the moment I am using the `CoefficientRules` command which gives in the above example               coef={{4, 0, 0, 0, 0} -> 1, {2, 2, 0, 0, 0} -> 1, {1, 1, 1, 1, 0} -> 2,            {0, 0, 1, 1, 2} -> 1, {0, 0, 0, 0, 4} -> 1}.      Then I sum over the rules in this list by               Sum[coef[[All, 2]][[k]]*       Product[c[coef[[All, 1]][[k, j]]], {j, 1, Length[coef[[All, 1]][[k]]]}],          {k, 1, Length[coef]}]      which is very inefficient. Any suggestions?


Elegant and fast way to join all string sequences

I want to do what title says: > {"a","b",1,2,3,4,"a",2,2,2,"edg","?"} => {"ab",1,2,3,4,"a",2,2,2,"edg?"} in the most elegant way. For example one replacement rule for `ReplaceAll`. I have manage to do this:               test = {"a", "a", 1, 2, "A", "b", 123, "a", "end"}     SplitBy[test, Head] /. {x__String} :> StringJoin[{x}] // Flatten      > {"aa", 1, 2, "Ab", 123, "aend"} But I find this way inelegant. Could You help me with creating good pattern? **Edit** Bonus request: It should be comparable in duration. Also there is not need to do this via pattern-matching. **Conclusion:** There are many great answers. Each one is educational and worth an upvote. I should now accept one, the problem is I have not stated this question's goal so clearly, my fault.   * rm -rf's is **the fastes and the shortest** however,   * I decided to **accept** Jacob's answer ~~as the fastest one and~~ because it seems it has not focused attention as it deserves.   * Yves Klett answer fulfill my need of a **single pattern** solution. As Mr. Wizard pointed out one could think I should accept rm- rf's answer. One could also think Yves Klett should receive it as his answer fits my primordial need. I will abuse a vague form of this question to give them a bounty insted.


Importing DICOM images

When I try to Import individual DICOM (.dcm) files from http://www.osirix- viewer.com/datasets/ datasets I can see the Elements listed in example files, ie:               {"BitDepth", "ColorMap", "ColorSpace", "Data", "Graphics", \     "GraphicsList", "Image", "ImageList", "ImageSize", "MetaInformation", \     "Overlays"}      Various metadata elements are imported correctly, but when Import'ing the Image or Graphics element, or simply an entire .dcm file, I get some combination of the following errors:               Import::fmterr: "Cannot import data as DICOM format. "     Import::nodta: "Insufficient data found for DICOM format."      The individual .dcm files themselves are small, less than 100kb each, but that should be enough to contain the actual 512x512 image. Also an assistant managed to open the files in the Osirix app. In Mathematica, the files' Data element is also imported but displayed as binary gibberish, is this the content? If so, why doesn't Mathematica interpret it? So, can someone replicate this or know how to display the images? (For example the WRIX dataset on the osirix site is only 5MB)


Efficient evaluation of function defined by multiple Sum

I tried to make a workable example here. The problem is that it is very very slow. I must be doing something very stupid out here. Can somebody give me some clue how to evaluate this multiple sum faster. Right now it takes around 2 mins. However, for real problem I need the parameter Npol to be of the order of ~10.               Clear["Global`*"];     SetSystemOptions["CompileOptions"->"CompileReportExternal"->False];     DRSH=N[(94688879/10000000)*10^(-7)];     Npol=2;     nk=40;     PN=Evaluate[Table[0.0025 n,{n,1,Npol}]];     OmN=Evaluate[Table[(1.0/DRSH)^((-n+2)/Npol),{n,1,Npol}]];     fpol[n_, On_]:=(-0.38 Sqrt[4^-n])/(DRSH + 0.77 2.0^-n)/; On== OmN[[1]]     fpol[n_, On_]:=(-0.38 Sqrt[4^-n])/(DRSH + 0.77 2.0^-n) (0.77 2.0^-n-On)/(0.77 2.0^-n+On)          OverLaps1=Compile[{{k, _Integer},{n,_Real}, {m,_Real}},Exp[-0.5 Sum[If[q!= k,(fpol[q, n]-fpol[q, m])^2,0],{q,0,nk}]],CompilationTarget->"C"];     OverLaps2=Compile[{{k, _Integer},{n,_Real}, {m,_Real}},Exp[-0.5 Sum[If[q!= k,(fpol[q, n]+fpol[q, m])^2,0],{q,0,nk}]],CompilationTarget->"C"];     NpolSum=Compile[{{i, _Integer},{j, _Integer}, {k, _Integer}}, (Sum[ Sum[PN[[n]]  PN[[m]] fpol[k, OmN[[n]]]^i fpol[k, OmN[[m]]]^j Exp[-0.5 (fpol[k, OmN[[n]]]^2+ fpol[k, OmN[[m]]]^2)] ( OverLaps1[k, OmN[[n]], OmN[[m]]]+ (-1.0)^j   OverLaps2[k, OmN[[n]], OmN[[m]]]),{n,1,Npol}],{m,1,Npol}])^2,CompilationTarget->"C"];          S2Entrp=Compile[{{k, _Integer}},Sum[Sum[ ( 1/(i! j!)  )  NpolSum[i, j, k],{i,0,10}],{j,0,10}]];     ListLogLinearPlot[Table[{k,S2Entrp[ k]}, {k,0, nk}],PlotStyle->Directive[PointSize[Medium],Red], PlotRange-> All]//AbsoluteTiming      I thank you for your time.


Unexpected side effect of removing the Orderless attribute from Times

First I make `Times` orderless:               ClearAttributes[Times, Orderless];      Then I evaluate               Expand[(x (y - z)]      which produces > x y + x (-1) z But when I evaluate               Distribute[x (y - z)]      I get > x y - x z This last is what I expected from both cases. My question is: Why does this happen? My interest is both academic and practical, since I would like to use things like ExpandAll later on my code.


Is the sharing of variables in Module/Block within Compile documented behavior?

Today I noticed something, I think for the first time. When used inside `Compile` variable values within `Module` (and `Block`) are sequentially shared:               Compile[{}, Module[{a = 7, b = a}, b + 1] ][]      > >     8 >   Compare the behavior outside of `Compile`:               Module[{a = 7, b = a}, b + 1]      > >     1 + a >     * Is this documented behavior or just a happy accident?   * If undocumented can it be relied upon or should this "trick" be avoided?


Mathlink program with low cpu usage on linux machines only

## Question I am incorporating some c++ code via Mathlink into my simulations in Mathematica. My questions involves the execution efficiency of the c++ code on different machines. For example, on my windows laptop i see (via task manager) that the Mathlink executable with the code i compiled accounts for roughly 98% cpu usage, while the mathematica kernel makes up the difference. This is what i expect, since the most calculation-intensive portion of the simulation is in the c++ code. However, running the exact same code on various linux machines, i see (via the "top" command) the cpu usage of the Mathlink executable ranging from 20% to 30%, with very little contribution due to the mathematica kernel. There are no competing processes making demands on the cpu in question. This is upsetting because I want to squeeze out every drop of cpu power I have available. Am I correct in thinking that my program is, in a sense, wasting cpu cycles? Is there a way to make the Mathlink executable approach 100% cpu usage? ## Possible Solution (but I hope not) My internet research into Mathlink program speed has primarily turned up discussions on the slow passing of data between the kernel and the Mathlink program. I suppose it is possible that the transfer of data (< 1 megabyte for each mathlink program call) is the bottleneck here. It could be that the linux computers are more efficient at performing the actual computation, but cannot pass the data fast enough for full cpu usage. Evidence against this solution comes from the following observations where, in the last column, I am comparing my rough estimates of how quickly (in how many seconds) the computation finishes.               OS      Mma Version Cpu         Usage   Computation Speed     ------- ----------- ---------   ----    ------------------------     Windows 7.0         2.2 GHz     98%     100% as fast as windows     Linux   8.0         2.8 GHz     30%     60%  as fast as windows     Linux   9.0         3.4 GHz     22%     40%  as fast as windows      Even if there is some kind of data passing bottlneck, shouldn't the faster computer still finish the computation faster in real time? ## Details On every machine, I am running the same Mathematica script (".m" file), which will `Install[]` the appropriate Mathlink executable depending on the machine's architecture. So the Linux slowdown is probably not due to different code. One relevant point may be the Mathematica version, 7.0 on my Windows machine (~100% cpu), 8.0 and 9.0 on the Linux machines (~25% cpu). ### Compilation Details (may not be relevant) For all I know, the details of the compilation of the Mathlink executable on linux is responsible for the slowdown. On both windows and linux, I am compiling my c++ code and template files using mprep and g++ (I cannot get mcc to work for me). On windows I am using:               mprep.exe function.tm -o function.tm.cpp      g++ -I <path-to-mathlink.h-folder> function.cpp function.tm.cpp  <path-to-libML32i3.a> -lm -lpthread -mwindows -lstdc++ -o mathlinkexecutable.exe      On different linux machines I am forced to use either the 32 bit or the 64 bit version of the Mathlink library (libML32i3.a and libML64i3.a respectively):               mprep function.tm -o function.tm.cpp      g++ -I <path-to-mathlink.h-folder> function.cpp function.tm.cpp  <path-to-correct-libML> -lm -lpthread -lrt -o mathlinkexecutable.bin


Frame and white background not working (all other colours are fine)

Though my question my be related to this one, it doesn't look like it can easily be solved in the same way, so I hope not to be double-posting. I am trying to insert a framed number/text into a graphics using `Epilog`. The text (black), the background (white) and the frame (coloured, e.g. orange) shall be of different colours. As a minimal working example, the following code indeed produces the desired result:               Graphics[{       LightGray, Disk[],        Inset[Framed[Style[ToString[text], Black, 50],         Background -> Pink,          FrameStyle -> {Orange}]]}]      ![first example](http://i.stack.imgur.com/vFvKQ.png) Yet, when I try to change the background colour to `White`, it simply is ignored!               Graphics[{       LightGray, Disk[],        Inset[Framed[Style[ToString[text], Black, 50],         Background -> White,          FrameStyle -> {Orange}]]}]      ![second example](http://i.stack.imgur.com/GlKCt.png) I know I could also apply the `Background` to the `Inset` rather than to the `Framed`, but that unfortunately results in the background colour slightly extending beyond the frame. I am using Mathematica version 6. Any help on this would be greatly appreciated!


Tooltip not working in web deployed cdf

I deployed a CDF file in a web page. I used both `Mouseover` and `Tooltip` functions. They both work in the raw CDF file. The `Mouseover` function works but the `Tooltip` function does not work in the web deployed version. Is there something else that has to be done to make this work? or does `Tooltip` just not work on the web-deployed CDFs?               projecttext = "Projects are initiated by ...";          project = {Mouseover["Project", {Text[projecttext]} // TableForm]} //        TableForm          combineddollarstext = "Combines the values from ...";          combineddollars = {Mouseover["Combined Dollars",                         {Text[combineddollarstext]} // TableForm]} //TableForm          measures = FlipView[{"Measures",                          {combineddollars, "reportedexpendituredollars",                           "grantobligationdata"} //TableForm}]          timeframe = {Tooltip["Year", "Projects are measured within Fiscal Years."]} //TableForm          LayeredGraphPlot[{project -> timeframe, timeframe -> measures,           measures -> "Compare", "Compare" -> "Filter"}, VertexLabeling -> True]


Save as Tex \(\(f(x))\)\) double \('s problem

a simple example Text Cell Style with a inline Cell (DisplayFormula)               Cell[TextData[{"inline mode ",Cell[BoxData[FormBox[RowBox[{"f", "(", "x", ")"}], TraditionalForm]], "DisplayFormula", FormatType->"TraditionalForm"], " "}], "Text"]      setting in Options `DefaultNewInlineCellStyle` is `DisplayFormula`. If setting in Options `DefaultNewInlineCellStyle` is `Text` this would not happen. I think someone would also encounter the situation: Converting between TraditinalForm and StandardForm sometimes auto-add or remove some (). When copy as Latex, it's ok to compile in WinEdt(my tex compiler‘s access)               f \text{inline} \text{mode} x          f(x)          \text{Null}      but when save notebook as .tex, load in file `f(x)` becomes               \(\(f(x)\)\)      The right should be               \(f(x)\)      ![enter image description here](http://i.stack.imgur.com/ubxXs.png) * * * I asked on the TeX StackExchange site and got some comments" > I am not on the other site, but in your _Mathematica_ set-up it does not > make much sense to say that inline should be rendered as `DisplayFormula`. > My guess is the converter used to output `$…$` for inline math and `$$…$$` > for display. Now `\\(…\\)` is often to be preferred for inline, but the > display equivalent is `\\[…\\]` not `\\(\\(…\\)\\)`. – Andrew Swann This is a good point. `DisplayFormula` ==> `$$`   `InlineFormula` ==> `$` This is MathJax. However, maybe the same to `\\(`. As Silvia's former suggestion, I should just not use `DisplayFormula` in inline cells. But I still need to check: would some other inline styles generate such double `\\(`s?


Rearranging an equation with the sine function in it

When I evaluate `Solve[a==Sin[b*c], b]` to rearrange the following for $ b $: $$ a = \sin(bc) $$ I get the following result from Mathematica: $$\begin{align*} \left\{\left\{b\to \text{ConditionalExpression}\left[\frac{-\sin ^{-1}(a)+2 \pi c_1+\pi }{c},c_1\in \mathbb{Z}\right]\right\},\right.\left.\left\{b\to \text{ConditionalExpression}\left[\frac{\sin ^{-1}(a)+2 \pi c_1}{c},c_1\in \mathbb{Z}\right]\right\}\right\} \end{align*}$$ It seems far too complicated. Unless I'm making a huge mistake, surely solving the equation for $ b $ would give: $$ b = \frac{\sin ^{-1}(a)}{c} $$ Am I doing something wrong?


Saving/exporting results from FindInstance and similar functions

I am dealing with a problem that requires the use of both FindInstance and FindRoot nested in a non-trivial way. The result is dependent on some parameter value $t \in [0,1)$, therefore I use               sol[t_]:=FindRoot[...]      For each t, the calculation of the result takes about 2 minutes (for some values of t it's faster, for others slower), resulting in               Plot[sol[t], {t,0,1}]      to take several hours. As I want to do further calculations/plots with $sol$, I learned from a previous question that i can "save" the results obtained by using               sol[t_]:=sol[t]=FindRoot[...]      However, this still requires me to redo the calculations every time I start Mathematica or the kernel dies for some unexpected reason. Is there a way to save/export the results obtained "within" $sol$, such that I can "load" them at the beginning of a session? (I apologize for the vague terms, please let me know if I need to clearify my question).


Exporting Specific Cells of Many Workbooks into One using Mathematica

I currently have a large number of detailed files from which I would like to extract certain cells' information to make an Archive spreadsheet. There are approximately 9 parameters of each spreadsheet I would like to import, which in principal could be copy/pasted individually. However, I have a huge number of spreadsheets to extract these parameters from, so I would like to specify to Mathematica to import (likely using `Import`) these parameters from each detailed file (say, named Run01.xlsx to Run0N.xlsx for N files), extract the parameters of interest (whose position doesn't change from file to file), and add (likely using `Append`) them to a seperate archive file (named Archive.xlsx in the same folder). I understand how to write to/from Excel files directly by using _MathematicaLink (3.5) for Excel,_ and that _Mathematica_ alone can `Import` & `Export` Excel files directly. But, I don't know how to incorporate a command that specifies that the content to be written is to be imported from Run0N.xlsx for N from 1 to, say, 40, each of which is to then be `Appended` to the file Archive.xlsx (within the same folder, even). Can anyone shed some light on this admittedly simple question?


Is the use of Block to temporarily override definitions inherently unsafe?

This may have been discussed before, if so, please let me know. * * * Consider the following example:               x = 5          Dynamic[{Clock[], x}]      This will always display the current value of `x`. Now evaluate               Block[{x}, Pause[5]]      Notice that `x` loses its global value! * * * **Question:** `Block` is commonly used to temporarily override definitions of user-defined symbols, package symbols, or built-ins. (There's also `Interal`InheritedBlock`.) What if, while the main (synchronous) evaluation is in the middle of a `Block`, it is interrupted by a pre-emptive (asynchronous) evaluation? This pre-emptive evaluation could come from some `Dynamic` construct in the front end or from a scheduled task. The `Block` in the main evaluation could potentially wreak havoc in the (supposedly independent) pre-emptive evaluation. This could cause very difficult to debug timing-dependent bugs that seem to occur completely randomly. This is very likely to happen if `Block` is used to override a builtin.


Rotating a set of 3D points against an arbitrary axis

I want to rotate a list of 3D points around unit vector (1,0,1) by the angle of Pi. How can I accomplish it?


Why is StringExpression faster than RegularExpression?

_Edit_ : as noted by Albert Retey the performance difference is only seen when sub expression extraction is performed. If this test is used below the timings are similar:               First@Timing[r1 = StringCases[textBig, se];]     First@Timing[r2 = StringCases[textBig, re];]      * * * According to the documentation: > Any symbolic string pattern is first translated to a regular expression. You > can see this translation by using the internal > `StringPattern`PatternConvert` function. >   >   >     StringPattern`PatternConvert["a" | "" ~~ DigitCharacter ..] // InputForm >   > >> >>     {"(?ms)a?\\d+", {}, {}, Hold[None]} >>   > > The first element returned is the regular expression, while the rest of the > elements have to do with conditions, replacement rules, and named patterns. > > The regular expression is then compiled by PCRE, and the compiled version is > cached for future use when the same pattern appears again. The translation > from symbolic string pattern to regular expression only happens once. Based on this I would expect a `StringExpression` and the regular expression produced by `PatternConvert` to perform similarly, but they do not. Taking an example from this recent question please observe:               se = Shortest["(ICD-9-CM " ~~ code__ ~~ ")"];     re = First @ StringPattern`PatternConvert[se] // RegularExpression      > >     RegularExpression["(?ms)\\(ICD-9-CM (.+?)\\)"] >                 text1 = "  A  Vitamin D Deficiency (ICD-9-CM 268.9) (ICD-9-CM 268.9) 09/11/2015  01 ";     textBig = StringJoin @ ConstantArray[text1, 1*^6];          First@Timing[r1 = StringCases[textBig, se :> code];]     First@Timing[r2 = StringCases[textBig, re :> "$1"];]          r1 === r2      > >     0.718 >     1.903 >     True >     * Why is using the `StringExpression` more than twice as fast as the `RegularExpression`?   * Is there a way to make the `RegularExpression` matching run just as quickly?


Underflow occurred in compilation

This code shown below works well for n<=10, if n>11, Mathematica gives the message > CompiledFunction::cfne: Numerical error encountered; proceeding with > uncompiled evaluation. >>. So compilation failed, my questions is: How can I make it compilable?               cf = Compile[{{n, _Integer}},         With[{c = Table[j + i*I, {i, -1.2, 1.2, .006015}, {j, -1.8, 0.6, .006015}]},             Exp[-Abs@Nest[#^2 + c &, c, n]]]];


Reconstructing an image from overlapping patches

The Mathematica function `ImagePartition` can create overlapping sub-images with the pixel offset options `{dw, dh}`:               ImagePartition[image, {w, h}, {dw, dh}]      Meanwhile, the `ImageAssemble` function has no such option documented. Hence my question is: how would one reconstruct an image made up of overlapping patches?   * Is there an "easy" way?    * Or do I need to work through the list of patches one-by-one? **Update:** If I want each overlapping patch to contribute equally to the value of a single pixel in the final image, what would I do? (Sorry, should have been clearer - have changed the title)


Simulate a simple spinner

I'm teaching some simple ideas in probability to students in grade 7. The "spinner" below works, but I'm wondering how I could make it just a bit more realistic by having it actually "spin" around a few times, slow down, and then end up where ever it has to be? I.E. randomly do a few complete circles and then slow down and stop..... Any suggestions are appreciated.                Manipulate[      Column[{             Show[         PieChart[{1, 1, 1, 1, 1}, ChartStyle -> "DarkRainbow",           ChartLabels ->            Placed[{2, 4, 6, 8, 10}, "RadialCenter", Style[#, 24] &],           LabelingFunction -> None],               Graphics[{                {PointSize[0.05], Point[{0, 0}]},                {Thick, Arrow[{{0, 0}, 0.7 { Cos[angle], Sin[angle]}}]}           }], ImageSize -> 600],        Button["Spin!", angle = RandomReal[{0, 6.28}]]        }       ]           , {{angle, 0, "Spin"}, 0, 2 \[Pi]}]


how can I convert a Grid object to a Graphics object?

I have a figure (which is by combining different plots) that I generated using `Grid[]`. The problem is, I want to specify the `ImageSize` of this final figure. I am unable to do it in `Grid[]`. Therefore, I wanted to convert this `Grid[]` object to `Graphics[]` object so that I can save it as a `PDF` of desired `ImageSize`. **Note** : I tried to save the output of `Grid[]` as `PDF` using `Export[]`. It works fine. However, when I set `ImageSize` in `Export[]`, it seems to be ignored. I tried               i=First@ImportString[ExportString[figure, "PDF"]];      But even this seems to lose clarity but this gives crispier image than `Rasterize` `Magnify[]` seems to do what I want even if It doesn't convert the figure to graphics, I can change the resolution by trial and error. Not the best way to do it but gets the job done.


Why is CountryData function failing?

I am unable to get the `CountryData` function to work. I have tried `FinancialData`, `CityData`, `WeatherData`, `AstronomicalData`, and `ProteinData`. They all work.               CountryData["France", "Population"]      > >     $Failed >                 FinancialData["GE", "MarketCap"]      > >     2.429*10^11 >   I wonder if the internet connection is different for `CountryData` but can't find a setting to change anything. I'm running 9.0.1.0.


Error messages in importing data file

> I want to copy the data in a public file (link in code below) and put each > row of the data as a sub-list, i.e., in the format >   >   >     {{Beginn,Ende,Dienst,ein/ausgehend,Laenge,Breite,Richtung,Cell- > Id_A,Cell-Id_B,},{8/31/09 7:57,8/31/09 > 8:09,GPRS,ausgehend,13.39611111,52.52944444,30,45830,XXXXXXXXXX,},{....},..}   >   > > I tried copying to _Mathematica_ using the code >   >   > > Import["https://docs.google.com/spreadsheet/ccc?key=\0An0YnoiCbFHGdGp3WnJkbE4xWTdDTVV0ZDlQeWZmSXc&authkey=COCjw- > kG&hl=en_\GB&authkey=COCjw-kG#gid=0"]   >   > > but it gives me the following error message               RegularExpression::maxrec: Recursion limit exceeded; positive match might be missed. >>      > I tried the alternative by first saving the file as CDFdata.csv on my > machine under and used the code >   >   >     Import["CDFdata.csv", Path -> "E:"]   >   > > but I get this error message >   >   >     Import::nffil: File not found during Import. >>   >   > > Can someone please provide guidance on how to proceed? Thanks.


characteristic polynomial based on differential equation

I have this differential equation: $$\ddot{x}-\frac{1}{6} \dot{x} - \frac{1}{6}x = e^t$$ When I DSolve it looks like this:               DSolve[x''[t] - 1/6 x'[t] - 1/6 x[t] == Exp[t], x[t], t]      Which gives me the correct answer. With that, we know I have the characteristic polynomial:               z^2 - 1/6 z - 1/6      I also find the roots:               Root[%,1]     Root[%%,2]      So all the results are correct. My question is, how can make this more easy for me, so I don't need to type manually the characteristic polynomial with its roots? I have tried with the function StringReplace to rewrite my differential equation into the characteristic polynomial, but it was messy and not functioning properly.


Set all instances of Exp[-x_] to zero?

To simplify a huge expression efficiently, which involves a variable in a bunch of exponential functions going to infinity, I have tried to substitute               /.Exp[-x_]->0      where my intention was to set to zero any exponential function featuring a minus sign in front of an arbitrary function. Unfortunately this substitution had no effect. How can I do what I intend? Please note, `Simplify` and `FullSimplify` functions involving any `ComplexityFunction` are not an option, since they take forever to evaluate. **EDIT** On a similar note, I noticed that oftentimes expressions of the same power appear as multipliers in numerator and denominator, like in the following example $$\frac{a f_{1}+af_2}{(a f_3+af_4)f_5}$$ still the $a$ does not cancel out automatically. Is there a command to explicitly look for such cancellations and carry them out without attempting any other simplifications? I tried `PowerExpand`, `Expand` and `ExpandAll`. None of them work like this.


How to speed up drawing a tangent plane?

I have this code to produce an interactive visualization of a tangent plane to a function:               Clear[f]     f[x_, y_] := x^3 + 2*y^3     Manipulate[      Show[       Plot3D[f[x, y], {x, -1, 1}, {y, -1, 1}, PlotStyle -> Opacity[0.8]],       Plot3D[f[point[[1]], point[[2]]] +         Limit[(f[point[[1]] + h, point[[2]]] - f[point[[1]], point[[2]]])/            h, h -> 0]*(x - point[[1]]) +         Limit[(f[point[[1]], point[[2]] + h] - f[point[[1]], point[[2]]])/            h, h -> 0]*(y - point[[2]]), {x, -1, 1}, {y, -1, 1},         PlotStyle -> Opacity[0.8], MeshStyle -> Gray]],      {{point, {0, 0}}, {-1, -1}, {1, 1}},       SaveDefinitions -> True]      It is, however, extremely slow. I suspect that the reason is that I unnecessarily compute the partial derivatives over and over again inside the second `Plot3D`, so my question is: how to change it? Note: I am using the above code also for other functions as discussed here, and that is the reason for the `Limit` in computation of partial derivatives.


Pop Up for Setting directory path

I am trying to build certain modules in Mathematica 9. I want it to dynamically ask for the directory path ( like file explorer ) when the code cell is executed. How can I do that ?               (*================================================= DIRECTORY CONTROL \============================================*)          Directory[];     (*current directory*)     SetDirectory[NotebookDirectory[]];(*set to local roaming directory *)          SetDirectory["File_Directory"];     (* set to local roaming SubDirectory *)


Solving $(-1-z)^n = z$, for $z$ in the unit circle

I want to solve the following equation: $$(-1-z)^n = z,\quad |z|<1,\quad n>1\in \mathbb{N}$$ where $z$ is a complex number. However `Solve` or `Reduce` didn't get me anywhere. Is there a way to do this?


Drawing a large set of Graphics3D cylinders provided a set of cylinder specifications in a list

I'd like to draw a large number of 3D cylinders using `Graphics3D`. My list specifying the cylinders has elements that look like the following:               { {{{p1x1, p1y1, p1z1}, {p2x1, p2y1, p2z1}},r1}, {{{p1x2, p1y2, p1z2}, {p2x2, p2y2, p2z2}},r2}, {{{p1x3, p1y3, p1z3}, {p2x3, p2y3, p2z3}},r3}, ...}      Here, the first subelement, e.g. `{{p1x1, p1y1, p1z1}, {p2x1, p2y1, p2z1}}`, specifies the coordinates for the two end-points of the cylinder, and the the second subelement, e.g. `r1` or `r2`, specifies the radius of the specific cylinder. Is there a way to use mapping to draw all of these cylinders with a condensed line of code?


Solving coupled eigenvalue differential equations

I am trying to solve an equation of the form as follows $\left(\begin{array}{cc} -\frac{\hbar^{2}}{2m}\frac{\delta^{2}}{\delta z^{2}}+\sin^{2}\left(z\right) & z\\ z & \frac{\hbar^{2}}{2m}\frac{\delta^{2}}{\delta z^{2}}-\sin^{2}\left(z\right) \end{array}\right)\left(\begin{array}{c} u_{n}(z)\\ v_{n}(z) \end{array}\right)==\epsilon_{n}\left(\begin{array}{c} u_{n}(z)\\ v_{n}(z) \end{array}\right)$ Assuming required no. of boundary conditions but with no knowledge of the eigenvalues, please tell how to solve such a system of equations in Mathematica. Here $n$ is an index for the eigenfunction and the corresponding eigenvalue. Take $z$ as real and assume that $z$ runs on a finite lattice of fixed size of length $L=Na$ where $N$ is the number of sites on the lattice and a is the lattice constant. If you take $a==1$, take $N$ of the order of $10000$. There is a specified value of the eigenfunctions at the boundary of the lattice which you can take zero for the simplest case. Please multiply everything by units such that dimensions are consistent- Here the derivative term is the kinetic energy term while sin2z term is the potential term.


How can I get vectorized text when exporting to pdf?

Consider this code:               data = Table[Sin[j^2 + i], {i, 0, Pi, Pi/3}, {j, 0, Pi, Pi/3}];     p1 = Graphics[Raster[data], Frame -> True, FrameStyle -> Large,        ImageSize -> 300];     p2 = ListDensityPlot[data, InterpolationOrder -> 0,        ColorFunction -> "GrayTones", Frame -> True, FrameStyle -> Large,        ImageSize -> 300];     Export["~/Downloads/1.pdf", p1, ImageResolution -> 100]     Export["~/Downloads/2.pdf", p2, ImageResolution -> 100]      Why does the font in the first plot appear vectorized while the the font in the second does not? ![enter image description here](http://i.stack.imgur.com/rlwWj.png) ![enter image description here](http://i.stack.imgur.com/cIKAV.png) _Update_ : remove the ImageResolution option will vectorize both plots, but ImageResolution is very helpful in reducing the pdf file size and I can't give up on that.               Export["~/Downloads/1.pdf", p1]     Export["~/Downloads/2.pdf", p2]      ![enter image description here](http://i.stack.imgur.com/5VEi9.png) ![enter image description here](http://i.stack.imgur.com/XZCce.png)


How to convert an image to a compressed string representation equivalent to one copied to clipboard by `CopyToClipboard[image]`?

In my recent question I asked How to embed an image into a string?   The suggested solution was               (* In[1]:= *) image = Import["http://wolfram.com/favicon.ico", "Image"];     (* In[2]:= *) str = ToString[image, StandardForm];      If I execute               (* In[3]:= *) CopyToClipboard[str];      and then paste it into a plain text editor (e.g. _notepad_ on _Windows_ ) than I get a very long and verbose string:               \!\(\*GraphicsBox[TagBox[RasterBox[RawArray["Byte", List[List[List[0, 0, 0, 0], (* ... *) List[0, 0, 0, 0]]]], List[List[0, 16], List[16, 0]], List[0, 255], Rule[ColorFunction, RGBColor]], BoxForm`ImageTag["Byte", Rule[ColorSpace, "RGB"], Rule[Interleaving, True]], Rule[Selectable, False]], Rule[BaseStyle, "ImageGraphics"], Rule[ImageSizeRaw, List[16, 16]], Rule[PlotRange, List[List[0, 16], List[0, 16]]]]\)      But if I copy the image to the clipboard directly               (* In[4]:= *) CopyToClipboard[image];      and then paste it into a plain text editor than I get a compressed representation:               \!\(\*     GraphicsBox[     TagBox[RasterBox[CompressedData["     1:eJyNUgss1HEc/+9CKBIyz928OodzCOdxcU95njh5tIQbpvUgDrFKWtIDPaZk     tLTmIiJbWR6pbLVSlNSI0S0j4bS8tiZ9Oi1NFvluv99+n+++n31/3+/nYyxK     CIojEQSRrCy/gqLT2ElJ0elCBTngpItjRWvkD43fZz75v3ibne/1+uIF0ipK     iVviDPd37ADrBdyRdYz8zZYz9yozS3UhdyckeVPl+csq/+LnpR7hvqG4yUaZ     /AP9gf6uMgqtdZwgoY3ilFbtEqJ5gxaa+Zizp7CuVKK03B+K1OwBkgl+MM1m     RnjG6GQZo1tJD7V6HGkTwUMfK0Gw0gyZWvSJJ0r2GBP5Y6goBv054ai3scU5     goEhgosB3zjHpZyykL2pD0nMqadkZ9yj2qOSYOKBiRcaOf4oZ3CRqspAsaEH     oO8IaNFHe7lBZlLPMKMB7g7qPL+ktEStx0kgnTO1xEBwAHrpbIz7haNdKESN     JwtnTeho5nOByG2YJXQBQgdf6VvRHbsv/c+uoyPM4eeK4TA/TIYJgIJTmC6/     irbcFNzmuaEpKhgTp3fik54aBnU2fR7wFdAXz9DnI5S8NzLHc3MqZAejMFlx     Ed8bqyAryseL7d6otnBAX7wQI+SNaN3mJVnglSYeXfuAubuhTnGzfEcaqNI3     RWegN3pOijFYdAJIT4DU2Rk3FSwgUWOgS8UK/dpWaDicwZvnF0Ts55+nel/K     0bU9U2VocP1ZgLu8Hw/tgTxI4/0wEcDEoKMDWmy24Jy6BY4Tlrgm16fOjj9V     IT4kWqpFl4217EOoJx7RLdCqtwEfPe0AcTDAdsBLbTrynH3Tdhmz1TPN+I7F     nCCXv3SMiF9fS1DQTKZBomMwUUNoYZpCwwzVAF8IVYwquqAlu0B5Oe8UBsb4     FPPC48o8vDWvkC1Z9Spus8PrGLjLYf3ya6ey3VhHbnHESv5bHPVOYe0Ngkjf     Bdxs6aFy/2Q+bbX8mpScjCpRovZKNT8BKotUng==     "], {{0, 16}, {16, 0}}, {0, 255},     ColorFunction->RGBColor],     BoxForm`ImageTag["Byte", ColorSpace -> "RGB", Interleaving -> True],     Selectable->False],     BaseStyle->"ImageGraphics",     ImageSizeRaw->{16, 16},     PlotRange->{{0, 16}, {0, 16}}]\)      Both the long and compressed strings, if being pasted back to a _Mathematica_ notebook, are automatically represented as the original image:               (* In[5]:= *) ![](http://wolfram.com/favicon.ico) I am interested in > _Question 1_ : How to get the compressed string programmatically, without > using the clipboard? The content of `CompressedData["..."]` looks like a result of the `Compress` function, and indeed it could be checked that               (* In[6]:= *) ToBoxes[image][[1, 1, 1]] ===       Uncompress["       1:eJyNUgss1HEc/+9CKBIyz928OodzCOdxcU95njh5tIQbpvUgDrFKWtIDPaZk       tLTmIiJbWR6pbLVSlNSI0S0j4bS8tiZ9Oi1NFvluv99+n+++n31/3+/nYyxK       CIojEQSRrCy/gqLT2ElJ0elCBTngpItjRWvkD43fZz75v3ibne/1+uIF0ipK       iVviDPd37ADrBdyRdYz8zZYz9yozS3UhdyckeVPl+csq/+LnpR7hvqG4yUaZ       /AP9gf6uMgqtdZwgoY3ilFbtEqJ5gxaa+Zizp7CuVKK03B+K1OwBkgl+MM1m       RnjG6GQZo1tJD7V6HGkTwUMfK0Gw0gyZWvSJJ0r2GBP5Y6goBv054ai3scU5       goEhgosB3zjHpZyykL2pD0nMqadkZ9yj2qOSYOKBiRcaOf4oZ3CRqspAsaEH       oO8IaNFHe7lBZlLPMKMB7g7qPL+ktEStx0kgnTO1xEBwAHrpbIz7haNdKESN       JwtnTeho5nOByG2YJXQBQgdf6VvRHbsv/c+uoyPM4eeK4TA/TIYJgIJTmC6/       irbcFNzmuaEpKhgTp3fik54aBnU2fR7wFdAXz9DnI5S8NzLHc3MqZAejMFlx       Ed8bqyAryseL7d6otnBAX7wQI+SNaN3mJVnglSYeXfuAubuhTnGzfEcaqNI3       RWegN3pOijFYdAJIT4DU2Rk3FSwgUWOgS8UK/dpWaDicwZvnF0Ts55+nel/K       0bU9U2VocP1ZgLu8Hw/tgTxI4/0wEcDEoKMDWmy24Jy6BY4Tlrgm16fOjj9V       IT4kWqpFl4217EOoJx7RLdCqtwEfPe0AcTDAdsBLbTrynH3Tdhmz1TPN+I7F       nCCXv3SMiF9fS1DQTKZBomMwUUNoYZpCwwzVAF8IVYwquqAlu0B5Oe8UBsb4       FPPC48o8vDWvkC1Z9Spus8PrGLjLYf3ya6ey3VhHbnHESv5bHPVOYe0Ngkjf       Bdxs6aFy/2Q+bbX8mpScjCpRovZKNT8BKotUng==       "]     (* Out[6]= True *)       Unfortunately, `RawArray`, `CompressedData` and `BoxForm`ImageTag` are all undocumented. It looks like `RawArray` represents (probably, optimized) internal representation of a multi-dimensional array, and `CompressedData` is equivalent to `Uncompress` (e.g. unless being held, it automatically evaluates to the object represented by the compressed string) except that `CompressedData` can be successfully interpreted as part of an input of the form `\\!\\(\\* ... \\)`. > _Question 2:_ Did I get their meaning right? Can they be useful in any other > context? Assuming I did it right, the closest result I was able to obtain to what I need is given by               (* In[7]:= *) toCompressedString[image_Image] :=       "\!\(\*" <> ToString[         ToBoxes[image] /.          array_RawArray :>            With[{compressed = Compress[array]},             CompressedData[compressed] /; True],         InputForm] <> "\)";      (`/; True` is the Trott-Strzebonski trick that I learned trying to write this code). Is there a more strightforward way to get this string?


Could not solve a set of equations with available mathematica tools

The problem I described below is an simplified way of expressing it.(Sorry that I still did not figure out a way to copy the code to here.) The actual equation is like![enter image description here](http://i.stack.imgur.com/skUP2.png) What I am trying to find is what value of `a` will leads to a non-zero value of H.So that the `FindInstance` is my first choice, but it could not solve it. I tried to understand the the behavior of the two functions by plotting them out. I first plot the left side of the first function, by setting B constant,and plot the left side with respect to H. It looks like this.![enter image description here](http://i.stack.imgur.com/MFfUI.png)![enter image description here](http://i.stack.imgur.com/rY5jB.png).It has a singularity point when H=B. I also plot second equation by setting B constant.And plot the right side of the equation with respect to H.The result is increase monotonic until it reaches infinity singularity when H=B. I tried to solve this set of equations.![enter image description here](http://i.stack.imgur.com/swVn1.png) But when I try to use Solve,Eliminate,Reduce , they told me "The equations appear to involve the variables to be solved for in an essentially non-algebraic way ". Then I tried to use Nsolve to do it by setting one of the variable constant. But it told me it could not solve it.![enter image description here](http://i.stack.imgur.com/sNAwa.png) So that I tried to use FindInstance to solve it. But it gives me this result.![enter image description here](http://i.stack.imgur.com/X5H73.png) But the k needs to be summed, which is not a variable. Then I tried to write it a little differently.It pops up some other problems as said below.![enter image description here](http://i.stack.imgur.com/jB5ks.png) I tried to simplify the problem to find out the problem. It gives me this.![enter image description here](http://i.stack.imgur.com/8twL8.png)


How to push the data from database?

I want to push the data from database to Mathematica application instead of application(MM App) pull the data.I have installed ms sql server and apache tomcat server. I have my application in apache tomcat, here I made connection to database. Now I want database send the data whenever there is update in data. But all I know is fetch the data from database is not good idea, because application needs to monitor the database for updated data will lead to fire the query for every 5 sec, this is not efficient as well. Suggest me good way to tackle this. Thanks


Elegantly split a matrix into positive and negative parts?

I have a matrix $M$ of real components, and I want to split it into two matrices $M^+$ and $M^-$ of the same dimensions as $M$, where $M^+$ contains the positive components of $M$ (the remaining entries being filled with zeros), and $M^-$ contains the negative components, such that $M=M^+ + M^-$. Suppose the matrices are represented in the usual way in Mathematica (as lists of lists, or as sparse arrays) How can I do this efficiently and elegantly in Mathematica?


VertexSize doesn't scale with Graph layout?

I wonder about how I could make a `Graph` scale automatically when I vary the size of the vertices. I would like to visualize information with a `Graph`. The vertices all have e.g. additional info like a weight which I would like to visualize with the vertices drawn with different sizes. However, when I define the sizes, the graph keeps the original (as opposed to the new) layout. The graph then becomes invisible.               Graph[{1 \[UndirectedEdge] 2, 2 \[UndirectedEdge] 3,3 \[UndirectedEdge] 1, 3 \[UndirectedEdge] 4}]      shows: ![Standard Graph](http://i.stack.imgur.com/AJ9WQ.jpg) Now I add the "weight"               Graph[{1 \[UndirectedEdge] 2, 2 \[UndirectedEdge] 3,3 \[UndirectedEdge] 1, 3 \[UndirectedEdge] 4},VertexSize -> {1 -> 1.1, 2 -> 1.2, 3 -> 1.3, 4 -> 1.4}]      This shows: ![not scaled](http://i.stack.imgur.com/SditS.jpg) What I would like is that the Graph would be like ![nice](http://i.stack.imgur.com/GldPG.jpg) Any thoughts? This is a graph currently working on. As you can see one vertex hits his neighbour. I would expect MM to or reposition this vertex a bit further or to scale down all nodes. Of course this can be done by dividing the vertexes by a number. But this is manual work to see what looks best. I hope there is another way. ![other example](http://i.stack.imgur.com/pE7Uk.jpg)


ArrayPlot with cells labeled by corresponding values

I would like to have `ArrayPlot[]` also present the value of each cell in it, similar to the `LabelingFunction` that is available in other types of plots. How do I do it?


What's the best way to select compatible options?

How do i safely, efficiently, and elegantly select compatible options? I normally do               foo[opts:OptionsPattern[]] := Module[         {goodOpts},         goodOpts = FilterRules[{opts}, Options[bar][[All,1]]];         bar[goodOpts]     ]      Is there any loophole where this can cause bugs? Is there a more efficient and more elegant way?


How can this function's options be used in different places?

I wrote this function to make a `ListPlot` where the points are colored by a third argument.               ColorListPlot[triples_, options : OptionsPattern[]] := ListPlot[       Transpose[{triples[[All, {1, 2}]]}],       PlotStyle -> (ColorData["Rainbow"] /@ Rescale[triples[[All, 3]]]),       PlotLegends -> BarLegend[{"Rainbow", Quantile[triples[[All, 3]], {0, 1}]}],       options     ]      Note that using `OptionsPattern` I have enabled this to accept options and pass them along to `ListPlot`. Now I'd like to label that legend using `LegendLabel`. If I pass a `LegendLabel` option to `ColorListPlot` it will end up being given to `ListPlot`. How can I modify the function so that the a `LegendLabel` option is passed to `BarLegend` and all other options end up in `ListPlot`?


Change some option of a function when calling it

Say I have defined some function like               f[p_] := Plot[Sin[p*x], {x, 0, 2 Pi}]      Now in most cases, I just need to specify the value of `p` and retrieve the plot. In a very few cases, I also want to change some option of the plot, e.g. `ImageSize -> Large`. Since my function in reality is a lot more convoluted and already has various optional arguments, I am trying to avoid a solution like               f[p_, size_:Automatic] := Plot[Sin[p*x], {x, 0, 2 Pi}, ImageSize->size]      I have tried e.g.               f[*some value*] /. ImageSize -> Large      but to no avail. Is there any way to achieve what I am attempting? Apologies if I am missing some fundamental features of Mathematica...


Standardizing a coset table via matrix manipulation

Suppose we have a group $G$ and a subgroup $H$. A coset table encodes the permutation representation of $G$ on the right cosets of $H$. When we want to use these coset tables in calculations, it is often first necessary to "standardize" them. This standardization works as follows: cycle through the table by row, and then by column (label the rows of the table $\alpha$ and the columns $x$). If the value of the first element of the table (call it $\beta_{11}$) is not 2, swap the 2nd row and the $\beta_{11}$th row of the table, and then swap all the entries in the table which have the value $\beta_{11}$ with all the entries which have the value 2. After this, we want the elements to be introduced in numerical order. So move onto the element $\left(1,2\right)$, with our test value now $\gamma=2+1=3$. If the value of this element is less than 3, do nothing. If the value of this element is equal to 3, that's also fine, but for subsequent elements the value we're looking for is $\gamma=4$. If the value of this element is greater than 3, then swap the 3rd row of the table with the $\beta_{12}$th row, and then swap all the entries in the table which have the value $\beta_{12}$ with all the entries which have the value 3. Continue in this way through the table. Once the end of the first row is reached, move onto the next row, etc. (This algorithm is described in depth in Holt et al. - _Handbook of Computational Group Theory_ ). To illustrate this standardization algorithm, consider the following matrix: $\begin{pmatrix}2 & 4 & 2 & 4\\ 3 & 1 & 3 & 1\\ 4 & 2 & 4 & 2\\ 1 & 3 & 1 & 3 \end{pmatrix}$ This should be reordered to: $\begin{pmatrix}2 & 3 & 2 & 3\\ 4 & 1 & 4 & 1\\ 1 & 4 & 1 & 4\\ 3 & 2 & 3 & 2 \end{pmatrix}$ This is because the first element is fine, but for the second element, 4>3, so swap the 4th and 3rd rows and then replace all the occurrences of 4 in the matrix with 3, and vice versa. After that, the algorithm does nothing. The function I have written for this standardization algorithm on a 4x4 matrix is the following:               standardize[a_] := Module[{alpha, beta, gamma, x},       gamma = 2;       For[alpha = 1, alpha <= 4, alpha++,        For[x = 1, x <= 4, x++,          beta = a[[alpha, x]];          If[beta >= gamma,           If[beta > gamma,            a[[{gamma, beta}]] = a[[{beta, gamma}]];            a = (a /. {beta -> gamma, gamma -> beta});            ];           gamma++;           ];          ];        ];       a // MatrixForm       ]      However, the following two lines bring up errors:               a[[{gamma, beta}]] = a[[{beta, gamma}]];     a = (a /. {beta -> gamma, gamma -> beta});      This is strange to me, because both of the lines work fine when you throw in a matrix normally. So would it be possible to tell me a) why errors come up here but not normally, and b) whether there is a possible fix?


How can I return private members of a Mathematica package as the output of package functions without the "PackageName`Private`" prefix?

I have created a Mathematica package that manipulates various types of input physics data into a common form of output data for further analysis. To make this process more efficient and manageable, I assign each specific set of data a different head and define the manipulation functions differently (as necessary) for each of the various heads. For example,               getX[data_AA] := data[[1]];     getY[data_AA] := data[[2]];     getZ[data_AA] := data[[3]];     getR[data_AA] := Module[{x=getX[data],y=getY[data]},Return[x^2+y^2]]     ...and so on...          getR[data_BB] := data[[1]];     getPhi[data_BB] := data[[2]];     getX[data_BB] := Module[{r=getR[data],phi=getPhi[data]},Return[r*Cos[phi]]]     ...and so on...          getX[data_CC] := data[[5]];     ...and so on...      Accordingly, I have written functions that change the heads of the data from List (since the data are imported from files into arrays) to their respective heads so that the data can then be used as arguments in the manipulation functions like the examples above: for example,               makeAA[AAdata_] := Return[AAdata /. List -> AA]      Because I want this to all be done internally, so that one cannot simply initialize a random object in a notebook with a global head of AA and then use the manipulation functions on that arbitrarily created object (see **Note** below), I have made the heads private members of the module. If the data is returned, however, by the function, say,               getAAdata[filename_]      then it is displayed as               PackageName`Private`AA[PackageName`Private`AA[particle 1 data],PackageName`Private`AA[particle 2 data],...,PackageName`Private`AA[particle N data]]      instead of the more concise and, therefore, more desirable               AA[AA[particle 1 data],AA[particle 2 data],...,AA[particle N data]]      (this is especially a problem when dealing with further nested arrays). So the question is: **how can I get private objects (heads, variables, etc.) to display in outputted data without the cumbersome and cluttering "PackageName`Private`" prefix**? **Note** : it is not sufficient to list the heads in the public part of the package because then, even though it would solve the above problem, it would introduce an additional problem that one would be able to initialize arbitrary objects with those heads -- say, `test=AA[2.1,3.2,5.4,2.3]` -- and then call `getX[test]`, which will then carry out the evaluation as it would any object with head `AA`. I want to reserve creating objects with those heads to other functions in the package (such as `makeAA`; see above). * * * This problem also shows up if I don't explicitly write a usage description/tag for a function and try to get information on the function by doing               ?Function      -- all the arguments and local variables are written with the "PackageName`Private`" prefix, making it rather difficult to read the body of the function. Thank you very much for your help!


Toggle visibility of elements in a plot

I have three simple graphs in one Plot. Now I am trying to make a button for each graph so you can hide or show it in the plot. Until now I was just able to make a checkbox with the Manipulate function, but I don't now how to tell the checkbox that it should hide my graph when unchecked an display it when checked. Here is what I was able to make so far, I know it looks simple but I also have many other mathematica documents which at the end just need this button. ![enter image description here](http://i.stack.imgur.com/QMqcr.png)


Map Elements of a list to be Index of matrix

I have a sublist from `Tuples[{1, 2, 3}, 2]`, say for example `L={{1,2},{2,1},{2,2}}`, and a 3 x 3 matrix `M`. My goal is to create a new list of matrices that has the same length as `L` and these matrices are the same as `M` except in the position indexed by elements of `L`, that is replaced by some constant number `s`. As I am used to Matlab, I did in an iterative way:               j=1;     While[j <= Length[L],        State = M;       State[[L[[j, 1]], L[[j, 2]]]] = s;       If[MemberQ[NewList, State] == False, AppendTo[NewList, State]];       ++j;     ];      but it would have be nicer to use the function `Map` I guess. So I'm looking for an elegant synthax since a little while. Thanks.


running a notebook with a batch file

I am using Windows (7 if needed). I am trying to learn how to write a batch file that EXECUTES a notebook. This is the batch               @echo off     START "C:\Programmi\Wolfram Research\Mathematica\8.0\MathKernel.exe" test.nb      it opens mathematica, but doesn't executes the notebook. So I tried (in the notebook) to select the cell and:               Cell>Cell properties>Initialization      but still it only opens the notebook. What am I missing? The notebook:               Export["C:\\Users\\MATTIA\\Desktop\\FIT\\Fam_II\\test.jpg",       Plot[Sin[x], {x, 0, 10}]]      just plots and saves a `sin` function


Mathematica 9 behavior with derivative of a sum

In:          D[Sum[Sin[x],x],x]          D[Sum[f[x],x],x]               Out:          1/2 Cos[1/2 (-1 - Pi + 2 x)] Csc[1/2]          0      Function f is undefined, but _Mathematica_ 9 counts it as constant? _Mathematica_ 8 returns ![Mathematica graphics](http://i.stack.imgur.com/7154K.png)


Remote Kernel - Error = MLECONNECT

Configuring a remote kernel with the Kernel Configuration Basic Options I manage to have a new kernel in the list of the kernel that I can open. However when I start the new kernel I get asked for the password and then nothing happens ... > The kernel MYKERNEL failed to connect to the front end. (Error = > MLECONNECT). > You should try running the kernel connection outside the > front end. My connection works both via ssh and via java ... `"java -jar /Applications/Mathematica.app/SystemFiles/Java/WolframSSH.jar user@host path/MathKernel"` Any suggestions or a less basic command that gives more info on the reasons of the failure of this connection? Thanks, Roberto


How to efficiently get the value from form UI built with dynamic InputField

Here is the code that I used to make a tabular UI.               DynamicForm[row_, col_] :=DynamicModule[{x = ConstantArray[0, {row, col}], a},          a = {Column[(Row[#] & /@Table[With[{i = i, j = j},                InputField[Dynamic[x[[i, j]]], Number,FieldSize -> Tiny]               ], {i, 1, row}, {j, 1, col}])]};         AppendTo[a, {CancelButton[], DefaultButton[DialogReturn[]]}];         CreateDialog[Column[Flatten@{a}, Spacings -> {1, Automatic},Alignment -> Left],         Modal -> True];         Dynamic@x       ];      ![enter image description here](http://i.stack.imgur.com/IT3vv.png) How can I retrieve the user input form the dialog?


Is there a triangle like this?

I want to find the numbers $a$, $b$, $c$, $d$ of the function $y = \dfrac{a x + b}{c x + d}$ so that the triangle $ABC$ with three points $A$, $B$, $C$ have integer coordinates and lies on the graph of the given function, then the centroid of the triangle $ABC$ (have also integer coordinates) is also lies on the graph. I tried               Clear[f, m, n, p];     f[x_] := (a x + b)/(c x + d);     m = {h, k};     n = {e, f};     p = {(m[[1]] + n[[1]] + x)/3, (f[m[[1]]] + f[n[[1]]] + f[x])/3}     Reduce[{p[[2]] == f[p[[1]]], f[h] == k, f[e] == f,      Sequence @@ Thread[0 < {a, b, c, d, e, f, h, k, x} < 10],      a < b < c < d}, {a, b, c, d, e, f, h, k, x}, Integers]      With my code, I get the answer is _False_. Is there a triangle like this?


How to add graphics options to an already produced plot having manipulator?

I am new to _Mathematica_ and stuck with one problem i.e. How can I add a graphics option to an already made plot which a manipulator to control itself.               s = Manipulate[        PopupWindow[         Graphics[          DiscretePlot[Sin[a t], {t, 0, 2 Pi, Pi/6}, ExtentSize -> Full,            ImageSize->Scaled[1], AspectRatio -> .2]], {a}],         OpenerView[{"Vertical", Control[{{a, 1, "Manipulator"}, 1, 30}]}],         ControlPlacement -> Bottom]      ![Mathematica graphics](http://i.stack.imgur.com/UO4iV.png) Now I want to add a plot `Label` by calling the already produced plot `s` because I don't want the duplication of code again as I have to use 4 more different plots in a popupmenu. For example, when I select `s` from then popupmenu then it should give the output `t`               t = Show[s, PlotLabel -> "Popup Window Plot"]        but this is showing error `Show::gtype: Manipulate is not a type of graphics.` Is there any way to sort out this problem? **Note:** The MathGroup version of the same question is found here.


Creating a random normal matrix

I would like to create a random matrix with the constraint that the matrix must be normal, i.e. the matrix and its Hermitian conjugate must commute. I would create a random matrix "without constraints" as                   RandomReal[NormalDistribution[0,s],{n,n}]+          I*RandomReal[NormalDistribution[0,s],{n,n}]      But I have no idea how I can implement the constraint, that the matrix must be normal.


Strange setting in FormatValues[MakeExpression]

My sytem is: 8.0 for Mac OS X x86 (64-bit) (October 5, 2011) When I start Mathematica and call               FormatValues[MakeExpression]        I get the following output: ![Mathematica graphics](http://i.stack.imgur.com/bbRo9.png) The message says: ![Mathematica graphics](http://i.stack.imgur.com/c5m7j.png) Where does it come from and what is a RefBox?


TabView switches tab number without user input in first evaluation

I've attempted to use `TabView` in a `Manipulate` to display sets of controls and alter a "display" associated with each set of controls:               Manipulate[      tick;      Dynamic@Switch[ tabNumber        , tab1, Plot[x^2, {x, 0, 1}]        , tab2, Plot[1 - x^2, {x, 0, 1}]        , _, Plot[Sin[x] E^(-x), {x, 0, 1}]        ]      , Dynamic@TabView[        {         "1" ->  Column[ tabNumber = tab1 ; { Row[{ "1 selected"}] } ],         "2" ->  Column[ tabNumber = tab2 ; Beep[] ; { Row[{ "2 selected"}] } ],         "3" ->  Column[ tabNumber = tab3 ; Beep[] ; { Row[{ "3 selected"}] } ]         }, Dynamic @tabNumber        ]      , {{tick, False}, None}      , {{tabNumber, 1}, None}      , {{tab1, 1}, None} , {{tab2, 2}, None} , {{tab3, 3}, None}      , TrackedSymbols :> {tick}      , ControlPlacement -> Left      ]      For interactive purposes, this works as desired. However, when the `Manipulate` is initially evaluated the tabs cycle from my default tab to the final tab. This is also seen in copies of the output cell (i.e. for the snapshot and thumbnail in a Wolfram demo selection). This prevents me from retaining the tabs that I'd like to display in each of the snapshots, which had been picked to display representative content. For that initial evaluation it seems that all the tabs get cycled through, despite the fact that I'd set an initial tab number. For example, the code above shows tab 3 as selected: ![output of above](http://i.stack.imgur.com/b8Gul.png) The two `Beep[]` calls above are also heard when the `Manipulate` initially runs. The end result is that something appears to be magically auto-selecting each of the tabs in sequence, but I think my method of recording which tab I am on, so that I can make my output panel adjust, is having a side effect of altering my tabNumber variable when the `TabView` is first evaluated. Presuming that is what is happening, how can I record my current tabNumber without the side effects seen above?


How can I solve my system of two simultaneous equations?

How to solve the system               {b - a*Sqrt[a^2 + b^2 + 1] - a^2*(a*b - Sqrt[a^2 + b^2 + 1]) == 0,        a - b*Sqrt[a^2 + b^2 + 1] - b^2*(a*b - Sqrt[a^2 + b^2 + 1]) == 0}      The command               Solve[{b - a*Sqrt[a^2 + b^2 + 1] - a^2*(a*b - Sqrt[a^2 + b^2 + 1]) == 0,             a - b*Sqrt[a^2 + b^2 + 1] - b^2*(a*b - Sqrt[a^2 + b^2 + 1]) == 0}           ,            {a, b}, Complexes]      produces, in particular, > >     {b -> -(a/(1 + a))}   >   which gives the wrong answer if $a=1.$ The answer obtained by the command               Reduce[{b - a*Sqrt[a^2 + b^2 + 1] - a^2*(a*b - Sqrt[a^2 + b^2 + 1]) == 0,             a - b*Sqrt[a^2 + b^2 + 1] - b^2*(a*b - Sqrt[a^2 + b^2 + 1]) == 0}            ,            {a, b}, Complexes]      also seems untrue in the last term > >     (a (1 + a) (-1 + a - a^2 + a^3) != 0 && >     0 == (1/(1 + a))(-1 - a - a^2 - Sqrt[(1 + a + a^2)^2/(1 + a)^2] - >      a Sqrt[(1 + a + a^2)^2/(1 + a)^2]) && b == -(a/(1 + a))). >


Preventing numeric constants from being pulled out of square roots

If I input `Sqrt[2 g]`, _Mathematica_ automatically pulls out the `2` and returns `Sqrt[2] Sqrt[g]`.   Is there any way I can prevent that and leave `Sqrt[2 g]` as is? (Running version _9_ ).


Zero-order interpolation not going fully around

Connected to this question, I want to do a zero-order interpolation of a bunch of datapoints which is periodic. The code I use is as follows:               dataSource = {{-0.225, 0.250}, {0.000, 0.250}, {0.225, 0.250}, {0.225,     0.250}, {0.296, 0.231}, {0.367, 0.108}, {0.367, 0.107}, {0.354,      0.048}, {0.341, 0.025}, {0.341,      0.025}, {0.265, -0.082}, {0.189, -0.190}, {0.189, -0.190}, {0.131,      -0.238}, {0.072, -0.250}, {0.072, -0.250}, {0.000, -0.250}, {-0.072,      -0.250}, {-0.072, -0.250}, {-0.131, -0.238}, {-0.189, -0.190},      {-0.189, -0.190}, {-0.265, -0.082}, {-0.341, 0.025}, {-0.341,      0.025}, {-0.354, 0.048}, {-0.367, 0.107}, {-0.367, 0.107}, {-0.296,     0.231}, {-0.225, 0.250}}          With[{ip = ListInterpolation[#, {{0, 1}}, InterpolationOrder -> 0,        PeriodicInterpolation -> True] & /@ Transpose[dataSource]},      fdata[t_] := Through[ip[t]]]          ParametricPlot[fdata[t], {t, 0, 1}, AspectRatio -> Automatic]      Which results in the following plot: ![enter image description here](http://i.stack.imgur.com/KXLgT.png) What I don't understand is why it doesn't draw the full contour? If I use `InterpolationOrder -> 1` it does work, but I don't want to do that for other reasons. **Can someone explain what is the problem that does not allow a periodic interpolation?** **For clarification, the reason I don't want to use the first order interpolation** is that it creates visual artifacts later on in the process: ![enter image description here](http://i.stack.imgur.com/TxKXz.png) As you can see the zero order extruded shape is nice and smooth, but with the gap from the cross-section. The first order extruded shape does not have this gap, but has a strange visual artifact. The dataset for this last part is:               dataSource={{-0.225,0.250},{-0.192,0.250},{-0.160,0.250},{-0.128,0.250},{-0.096,0.250},{-0.064,0.250},{-0.032,0.250},{0.000,0.250},{0.032,0.250},{0.064,0.250},{0.096,0.250},{0.128,0.250},{0.160,0.250},{0.192,0.250},{0.225,0.250},{0.225,0.250},{0.230,0.250},{0.236,0.250},{0.242,0.249},{0.248,0.248},{0.254,0.247},{0.260,0.245},{0.266,0.244},{0.272,0.242},{0.278,0.240},{0.284,0.237},{0.290,0.234},{0.296,0.231},{0.302,0.227},{0.308,0.223},{0.314,0.219},{0.320,0.214},{0.326,0.208},{0.331,0.202},{0.337,0.195},{0.343,0.186},{0.349,0.176},{0.355,0.164},{0.361,0.148},{0.367,0.108},{0.367,0.107},{0.366,0.090},{0.365,0.083},{0.364,0.077},{0.363,0.072},{0.362,0.068},{0.361,0.065},{0.359,0.061},{0.358,0.058},{0.357,0.055},{0.356,0.053},{0.355,0.050},{0.354,0.048},{0.353,0.045},{0.352,0.043},{0.351,0.041},{0.350,0.039},{0.349,0.037},{0.347,0.035},{0.346,0.033},{0.345,0.032},{0.344,0.030},{0.343,0.028},{0.342,0.027},{0.341,0.025},{0.341,0.025},{0.330,0.010},{0.319,-0.006},{0.308,-0.021},{0.297,-0.036},{0.287,-0.052},{0.276,-0.067},{0.265,-0.082},{0.254,-0.098},{0.243,-0.113},{0.232,-0.128},{0.221,-0.144},{0.211,-0.159},{0.200,-0.174},{0.189,-0.190},{0.189,-0.190},{0.184,-0.196},{0.179,-0.202},{0.174,-0.207},{0.169,-0.212},{0.165,-0.216},{0.160,-0.220},{0.155,-0.224},{0.150,-0.227},{0.145,-0.230},{0.140,-0.233},{0.136,-0.235},{0.131,-0.238},{0.126,-0.240},{0.121,-0.242},{0.116,-0.243},{0.111,-0.245},{0.106,-0.246},{0.102,-0.247},{0.097,-0.248},{0.092,-0.249},{0.087,-0.249},{0.082,-0.250},{0.077,-0.250},{0.072,-0.250},{0.072,-0.250},{0.062,-0.250},{0.052,-0.250},{0.041,-0.250},{0.031,-0.250},{0.021,-0.250},{0.010,-0.250},{0.000,-0.250},{-0.010,-0.250},{-0.021,-0.250},{-0.031,-0.250},{-0.041,-0.250},{-0.052,-0.250},{-0.062,-0.250},{-0.072,-0.250},{-0.072,-0.250},{-0.077,-0.250},{-0.082,-0.250},{-0.087,-0.249},{-0.092,-0.249},{-0.097,-0.248},{-0.102,-0.247},{-0.106,-0.246},{-0.111,-0.245},{-0.116,-0.243},{-0.121,-0.242},{-0.126,-0.240},{-0.131,-0.238},{-0.136,-0.235},{-0.140,-0.233},{-0.145,-0.230},{-0.150,-0.227},{-0.155,-0.224},{-0.160,-0.220},{-0.165,-0.216},{-0.169,-0.212},{-0.174,-0.207},{-0.179,-0.202},{-0.184,-0.196},{-0.189,-0.190},{-0.189,-0.190},{-0.200,-0.174},{-0.211,-0.159},{-0.221,-0.144},{-0.232,-0.128},{-0.243,-0.113},{-0.254,-0.098},{-0.265,-0.082},{-0.276,-0.067},{-0.287,-0.052},{-0.297,-0.036},{-0.308,-0.021},{-0.319,-0.006},{-0.330,0.010},{-0.341,0.025},{-0.341,0.025},{-0.342,0.027},{-0.343,0.028},{-0.344,0.030},{-0.345,0.032},{-0.346,0.033},{-0.347,0.035},{-0.349,0.037},{-0.350,0.039},{-0.351,0.041},{-0.352,0.043},{-0.353,0.045},{-0.354,0.048},{-0.355,0.050},{-0.356,0.053},{-0.357,0.055},{-0.358,0.058},{-0.359,0.061},{-0.361,0.065},{-0.362,0.068},{-0.363,0.072},{-0.364,0.077},{-0.365,0.083},{-0.366,0.090},{-0.367,0.107},{-0.367,0.107},{-0.361,0.148},{-0.355,0.164},{-0.349,0.176},{-0.343,0.186},{-0.337,0.195},{-0.331,0.202},{-0.326,0.208},{-0.320,0.214},{-0.314,0.219},{-0.308,0.223},{-0.302,0.227},{-0.296,0.231},{-0.290,0.234},{-0.284,0.237},{-0.278,0.240},{-0.272,0.242},{-0.266,0.244},{-0.260,0.245},{-0.254,0.247},{-0.248,0.248},{-0.242,0.249},{-0.236,0.250},{-0.230,0.250},{-0.225,0.250}};


Inverse of a large sparse Hermitian block matrix

I am looking for a method (if it exists) for the inverse of a large sparse Hermitian block matrix. The off diagonal sparse matrices, named `δ` are 4x4, and they have only one non null element on the diagonal part. The matrices `M` are Hermitian and also 4x4. I need a way to perform the inverse of `M3` or the determinant. I am interested in a generalization of this structure for a matrix of higher rank with the same "telescopic" structure. Here is the code               dimension        = 4;     mat              = ( {{m, a, b, b},{Conjugate[a], m, b, b},{Conjugate[b], Conjugate[b], m, a},{Conjugate[b], Conjugate[b], Conjugate[a], m}});     Subscript[O, 4]  = ( {{0, 0, 0, 0},{0, 0, 0, 0},{0, 0, 0, 0},{0, 0, 0, 0}} );     Subscript[δ, 1]  = ( {{I ρ, 0, 0, 0},{0, 0, 0, 0},{0, 0, 0, 0},{0, 0, 0, 0}} );     Subscript[δ, 2]  = ( {{0, 0, 0, 0},{0, I ρ, 0, 0},{0, 0, 0, 0},{0, 0, 0, 0}} );     Subscript[δ, 3]  = ( {{0, 0, 0, 0},{0, 0, 0, 0},{0, 0, I ρ, 0},{0, 0, 0, 0}} );     Subscript[δ, 4]  = ( {{0, 0, 0, 0},{0, 0, 0, 0},{0, 0, 0, 0},{0, 0, 0, I ρ}} );     Subscript[δ, 22] = ArrayFlatten[( {{Subscript[O, 4], Subscript[δ, 2]}, {Subscript[δ, 2], Subscript[O, 4]}})];     Subscript[δ, 33] = ArrayFlatten[( {         {Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[δ, 3]},         {Subscript[O, 4], Subscript[O, 4], Subscript[δ, 3], Subscript[O, 4]},         {Subscript[O, 4], Subscript[δ, 3], Subscript[O, 4], Subscript[O, 4]},         {Subscript[δ, 3], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4]}     } )];     Subscript[δ, 44] = ArrayFlatten[( {         {Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[δ, 4]},         {Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[δ, 4], Subscript[O, 4]},         {Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[δ, 4], Subscript[O, 4], Subscript[O, 4]},          {Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[δ, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4]},          {Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[δ, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4]},         {Subscript[O, 4], Subscript[O, 4], Subscript[δ, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4]},         {Subscript[O, 4], Subscript[δ, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4]},         {Subscript[δ, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4], Subscript[O, 4]}     } )];          OutM[M_, δ_] := ArrayFlatten[{{M, δ},{-δ, M}}];     M1 = OutM[mat, Subscript[δ, 1]];     M2 = FullSimplify[OutM[M1, Subscript[δ, 22]]];     M3 = FullSimplify[OutM[M2, Subscript[δ, 33]]];     M4 = FullSimplify[OutM[M3, Subscript[δ, 44]]];      And I need the inverse of `M4`. The structure is telescopic in some sense.


On the parallelization of matrix multiplications in Mathematica 8

I have installed _Mathematica_ 8, but I think the commands for parallelizations do not work! Even when I try to test the example in the Help of _Mathematica_ , I face with > ParallelDo::nopar: No parallel kernels available; proceeding with sequential > evaluation. Please guide me how to resolve this problem. In fact I wish to then use `ParalledDo` in the following code to reduce the computational time:               ClearAll[n, A, V, Id, b, L, i, pr]     n = 1000;     A = SparseArray[{{i_, i_} -> 3 i, {i_, j_} /; i == j + 1 -> j}, {n,          n}];     b = SparseArray[Table[1, {i, n}]];     DA = Diagonal[A];     B = SparseArray[Table[(1/DA[[i]])^1, {i, 1, n}]];     Id = SparseArray[{{i_, i_} -> 1}, {n, n}];     V = SparseArray[DiagonalMatrix[B]];     ParallelDo[     VV = SparseArray[A.V];       V = SparseArray[V].SparseArray[2 Id - VV];       L[i] = Norm[N[SparseArray[b - SparseArray[A].SparseArray[V.b]]]];       Print["The residual norm of the linear system solution is:"          Column[{i}, Frame -> All, FrameStyle -> Directive[Blue]]          Column[{L[i]}, Frame -> All, FrameStyle -> Directive[Blue]]];       , {i, 4}] // Timing      I will be thankful if anyone gives me some tips to reduce the computational cost of matrix-by-matrix multiplications in the above written code.


CreateDocument using a specific Evaluator (Kernel)

I was trying to build a button to create a new document that contained a dynamicaly changing table. In the parent notebook i am using another kernel - not the usual "Local". The problem is that in the created document (using CreateDocument command) the kernel that uses seems to be locked at Local giving no results (or errors). Does enybody knows how the Created Document can use the kernel of the parent notebook ? Thanks in advance!


Manipulate and function definition

I have read the documentation, and know the way Initialization works with Manipulate, but I can't seem to understand why this piece of code               Manipulate[      Plot[h[x], {x, -3, 3}]      , {b, -5, 5}      , Initialization :> (h[x_] := x + b)]      produces a static graph. I know that if I change the function `h[x]` to `h[x_,b_]`, then the `Manipulate` gives a dynamic graph, but I would like the function `h` to have one parameter (instead of two), if possible. What am I missing here? Thanks, as always, for all help!


How to improve gesture detection by JLink for the LeapMotion controller

Building on this thread (where I cannot add anything anymore somehow) and with this nice answer I kind of got swipe detection to work, but it is not very responsive. How to improve (in the sense of making it more robust, sensitive) this code?                  (* this is the directory where LeapSDK is *)         $leapdir =                FileNameJoin[{$UserBaseDirectory, "Applications",                  "LeapDeveloperKit"}];             If[FileExistsQ[$leapdir], Needs["JLink`"];           Block[{nativelibs},             With[{(*the location of the developer kit:*)              lmlib = FileNameJoin[{$leapdir, "LeapSDK", "lib"}]},                  nativelibs =                   FileNameJoin[{lmlib,                     Switch[$SystemID, "Windows-x86-64", "x64", "Windows", "x86"]}];             (*now start Java*)             JLink`ReinstallJava[              JLink`ClassPath -> FileNameJoin[{lmlib, "LeapJava.jar"}],               JLink`JVMArguments ->                "-Djava.library.path=\"" <> nativelibs <> "\""]]]];              controller = JavaNew["com.leapmotion.leap.Controller"];         LoadJavaClass["com.leapmotion.leap.Gesture$Type"];             If[Not[controller@isGestureEnabled[Gesture$Type`TYPEUSWIPE]],           controller@enableGesture[Gesture$Type`TYPEUSWIPE]               ];             controller@isGestureEnabled[Gesture$Type`TYPEUSWIPE];         gesturePrint[controller_] := Module[{gesture},           gesture = controller@frame[]@gestures[]@get[0];           If[(gesture@type[]@name[]) === "TYPE_SWIPE",            swipe = JavaNew["com.leapmotion.leap.SwipeGesture", gesture];                 {swipe@state[]@toString[],             (swipe@position[]@#) & /@ {getX[], getY[], getZ[]},             (swipe@direction[]@#) & /@ {getX[], getY[], getZ[]},             swipe@speed[]             }]]         ud = .05;         Dynamic[gesturePrint[controller], UpdateInterval -> 0.1]


How to capture Print output

How can I capture output from Print from a function which does not leave the printed object as its final output, (and which I do not wish to edit)? E.g.               Module[{},      Print[Plot[Sin[x], {x, 0, 2 Pi}]];      a = 123]      I would like to use something like a temporary setting for `$PrePrint` or `$Post`, rather than use cell selection (`SelectionMove`, `NotebookRead`). The aim is somehow to intercept the `Print` output -- the plot object -- and set it to a variable, (without altering the module). This attempt did not work:- ![enter image description here](http://i.stack.imgur.com/mynMQ.png)


Haiku Extractor

Inspired by the cool Tumblr Haiku Times that searches for accidental haiku in New York Times articles, I tried my hand at implementing such a search in Mathematica for my own text samples. I'm still not a one-liner writer, so I'd welcome any input on more efficient approaches than mine below (especially the Table in Step 4!), but to follow the rules my question is how to implement my Step 6 automatically as I'm doing it manually now: Step 1. Read in text               sampleText =  "Haikus are easy but sometimes they don't make sense refrigerator. Make a man a king today and tomorrow he will be a brigand. Dragonflies, by contrast, look dainty, glittery and fun, like a bubble bath or costume jewelry, and they're often grouped with butterflies and ladybugs on the very short list of Insects People Like.";      Step 2. Break up paragraphs into sentences at periods               sampleSentences = StringSplit[sampleText,"."]       Step 3. Break up sentences into words               sampleWords = StringSplit[sampleSentences]       Step 4. Count each sentence's syllables               syllableCount[x_] := Length[WordData[x, "Hyphenation"]]     sampleSyllables =       Table[Apply[Plus,         Map[syllableCount, ToLowerCase[sampleWords[[i]]]]], {i, 1,         Length[sampleWords]}]          {16, 17, 41}      Step 5. Select the sentences with 17 syllables               sampleHaiku =       sampleSentences[[Flatten[Position[sampleSyllables, 17]]]]          {" Make a man a king today and tomorrow he will be a brigand"}      Ironically:               syllableCount["haikus"]          1      Step 6. Break the 17-syllabic ones up at 5, 7, 5 and display the result   (I ran out of ideas here...) Thanks in advance and apologies for protocol/formatting gaffes on my first post!


Exact cover solution

Is it possible to get a exact cover solution(s) and/or number of possible solutions in Mathematica?


How does SocialMediaData determine vertex size

How does SocialMediaData determine the size of graph vertices, e.g. on what does the vertex size depend in, say, a Facebook friend network graph?


Simple Choice-Dialog like the auto-completion popup

What I want is pretty simple, nevertheless, after half an hour I have only unsatisfying solutions here. Let me ask you who might work more often with _Mathematica_ 's GUI elements: Is there a way to implement a dialog in _Mathematica_ which works in general like the autocompletion popup. > ![enter image description here](http://i.stack.imgur.com/FF8x9.png) The dialog doesn't has to popup automatically but it should have the following features:   * it is a **fixed** list of entries, where the first entry is always selected and you can use the arrow keys to navigate up and down   * on `Enter` or `Esc` the dialog closes where in the first case, some identifier with the selected entry is returned   * I can use a unique "short-key" which lets me directly select and return one of the entries. So for instance if my list of choices is `{"Module","Block","With"}` I could use e.g. `m`, `b` and `w` to select the corresponding entry. I have played with various dialogs, button bars and `EventHandler` without luck. Bevor I investigate further, I thought asking is probably the better choice.