Why isn't Lookup treated like other symbols?

With Mathematica 10, I wanted to overload `Lookup` using `TagSetDelayed`, but it doesn't work. For instance, if I define two objects with head `TempHead`               t1 = TempHead[a -> 1, b -> 2, c -> 3];     t2 = TempHead[c -> 3, d -> 4, e -> 5];      I can overload `Plus` as usual:               TempHead /: Plus[t1_TempHead, t2_TempHead] := TempHead @@ Join[List @@ t1, List @@ t2]      So:               t1 + t2     (* TempHead[a -> 1, b -> 2, c -> 3, c -> 3, d -> 4, e -> 5] *)      But, if I do the same thing with Lookup, it doesn't work:               TempHead /: Lookup[t1_TempHead, t2_TempHead] := TempHead @@ Join[List @@ t1, List @@ t2]     Lookup[t1,t2]     (* Lookup::invrp: The argument TempHead[a->1,b->2,c->3] is not a valid Association or a list. >> *)      Further, you cannot even use `Unprotect` to overload `Lookup`. I thought this was a bug, but when I reported it to Wolfram, they said `Lookup` was designed to give an error on all objects that aren't `Associations`. Certainly there are Mathematica functions that give errors (e.g. `Part`, when you try to access outside the length of a `List`), but you can usually still overload them. Does anyone know if there is a good reason for implementing `Lookup` this way? It seems to break with the "Everything is an expression" principle that Wolfram is always touting. Are there other symbols that act like `Lookup`?


Mathematica function Det has unexpected behavior

I am using _Mathematica_ "Kernel" -> {"Version" -> "9.0 for Microsoft Windows (64-bit) (January 25, 2013)", "ReleaseID" -> "9.0.1.0 (4055652, 4055188)" on a Win 7 machine. The file listed below uses the _Mathematica_ function `Det` to compute the determinant of a matrix whose matrix elements are either: [1] 0 [2] const + const * m^2 , m may be complex [3] const * k^2 [4] const * w^2 This file computes the determinant of four different matrices. The first two seem OK. However, for the last two determinants [in **BOLD** ], _Mathematica_ has given each result as a RATIO, where the denominator of the ratio may, in fact, vanish. Since the determinant is an algebraic sum of products of matrix elements, I do not understand where the denominators of the last two determinants come from. Does anyone know how to prohibit _Mathematica_ from dividing?               ssg={sg->2^(1/3) Gamma[2/3]};          sys[nt_,start_][k_,w_,m_]:=          Module[{n,var,D5,D6,cLD600,cLD6,residu,ca,q,nx,ret},     If[Not[0=== start || 1=== start],Return[{{}}]];     n=2nt+1;     Print[n(2nt+1)," VARIABLES; ",n(2nt+1+2)," EQUATIONS: TOO MANY EQUATIONS"];     Print[2n," = # EXTRA EQUATIONS"];     If[1=== start,nx=2 n-1];     If[0=== start,nx=2(n-1)];     If[1=== start,q=If[#>= 0,F[#1,#2],-F[-#1,#2]]&];     If[0=== start,q=If[#>= 0,F[#1,#2],F[-#1,#2]]&];     var=Flatten[ParallelTable[q[n8,j],{n8,start,nx,2},{j,-nt,nt}]];     D5=ParallelTable[Sum[-(3/20) X^j q[n8,j]-1/2 m^2 X^j q[n8,j]-n8^2 X^j q[n8,j]-1/2 X^-1 k^2 sg X^j q[n8,j]+1/2 X w^2 sg X^j q[n8,j]-1/9 X^j j^2 q[n8,j]-1/2 X^-1 k^2 sg Sum[((-1)^n8m8 (X^j UnitStep[-2n8m8+n8+nx]q[n8-2 n8m8,j]+X^j UnitStep[nx-(2n8m8+n8)]q[n8+2 n8m8,j]))/(Gamma[5/6-n8m8] Gamma[5/6+n8m8]),{n8m8,1,nx}]+1/2 X w^2 sg Sum[ ((-1)^n8m8 (X^j UnitStep[-2n8m8+n8+nx]q[n8-2 n8m8,j]+X^j UnitStep[nx-(2n8m8+n8)]q[n8+2 n8m8,j]))/(Gamma[5/6-n8m8] Gamma[5/6+n8m8]),{n8m8,1,nx}],{j,-nt,nt}],{n8,start,nx,2}];     D6=ExpandAll[X^(1+nt) D5];     cLD600=Flatten[CoefficientList[D6,X]];     cLD6=Drop[Drop[cLD600,-n],n];     residu=Flatten[{Take[cLD600,n],Take[cLD600,-n]}];     ca=CoefficientArrays[Block[{u},     u=Flatten[cLD6];     Thread[u==Table[ 0,{Length[u]}]]],var];     ret={var,ca,residu};     ret     ]          (* EXAMPLE 1 *)          s1odd=sys[1,1][k,w,m];          Expand[FullSimplify[Det[N[Normal[s1odd[[2]][[2]]]/.ssg]/.{k^2->KS,w^2->KT,m^2->M}]/.{0.`->0}]/.{KT->W/KS}]          (* 0.886661 W^3+0.146364 M W^3+0.0080522 M^2 W^3+0.000147638 M^3 W^3-5.43201*10^-18 W^4-2.51499*10^-19 M W^4          (* EXAMPLE 2 *)          s1even=sys[1,0][k,w,m];          Expand[FullSimplify[Det[N[Normal[s1even[[2]][[2]]]/.ssg]/.{k^2->KS,w^2->KT,m^2->M}]/.{0.`->0}]/.{KT->W/KS}]          (* 0.541822 W^3+0.21145 M W^3+0.0273022 M^2 W^3+0.00116764 M^3 W^3-1.11445*10^-17 W^4-1.47813*10^-19 M W^4 *)          (* EXAMPLE 3 ; PROBLEM WITH Det[] *)          s2odd=sys[2,1][k,w,m];          s2odd[[2]]          (* {SparseArray[<0>,{25}],SparseArray[<187>,{25,25}]} *)          (N[Normal[s2odd[[2]][[2]]]/.ssg]/.{0.`->0})[[1]]          (* {0,0,0,0.719142 w^2,-1.59444-0.5 m^2,0,0,0,0.0486904 w^2,0,0,0,0,0.020049 w^2,0,0,0,0,0.011332 w^2,0,0,0,0,0.00742443 w^2,0} *)          Det[N[Normal[s2odd[[2]][[2]]]/.ssg]]/.{0.`->0}     Denominator[%]     FullSimplify[%]          (* -(NUMERATOR)/(k^142 w^170 (3.41252*10^-54 k^30 w^2+3.47154*10^-56 k^30 m^2 w^2)^2)          k^142 w^170 (3.41252*10^-54 k^30 w^2+3.47154*10^-56 k^30 m^2 w^2)^2          **k^202 (3.41252*10^-54+3.47154*10^-56 m^2)^2 w^174**  *)           (* EXAMPLE 4 ; PROBLEM WITH Det[] *)          s2even=sys[2,0][k,w,m];          s2even[[2]]          (* {SparseArray[<0>,{25}],SparseArray[<187>,{25,25}]} *)          (N[Normal[s2even[[2]][[2]]]/.ssg]/.{0.`->0})[[1]]          (* {0,0,0,0.853041 w^2,-0.594444-0.5 m^2,0,0,0,0.267797 w^2,0,0,0,0,0.170416 w^2,0,0,0,0,0.130318 w^2,0,0,0,0,0.107654 w^2,0} *)          Det[N[Normal[s2even[[2]][[2]]]/.ssg]]/.{0.`->0};     Denominator[%]     FullSimplify[%]          (* k^118 w^206 (1.96078*10^-19 k^6 w^14+2.712*10^-21 k^6 m^2 w^14)^4             k^142 (1.96078*10^-19+2.712*10^-21 m^2)^4 w^262 *)


Finding minimum fly-by radius between Mars and spacecraft from interpolating function

I've written an interplanetary trajectory solver/plotter that plots the path taken by a spacecraft on an Earth-Mars mission, but have run into a little trouble when the spacecraft actually reaches Mars. I'm hoping to be able to get the spacecraft into an orbit around Mars upon arrival, but before I can do that I need to find its closest approach in order to apply the correct delta-v at the right time (using the wonders of NDSolve's WhenEvent function). The trajectory plot relies on the output of an interpolating function from NDSolve, and it is this interpolating function that I am trying to work with. So far I know when the closest approach occurs to within a day, and it is between days 254 and 255 of the trip. I have put the Heliocentric x-y positions of Mars and the spacecraft (between days 254 and 255) into separate tables using the following:               MarsPosition = Table[{x[2][t], y[2][t]} /. Soln, {t, 254*86400, 255*86400, 86400/100}]      SpaceCraftPosition = Table[{x[3][t], y[3][t]} /. Soln, {t, 254*86400, 255*86400, 86400/100}]      And have then calculated their relative x-y positions using the following:               dxy = Sqrt[(MarsPosition - SpaceCraftPosition)^2]      But I am now trying to calculate the minimum approach radius (i.e. combining the x-y positions into a magnitude) from the above bits of code. My futile attempt of trying               dr = Min[Sqrt[dxy[1]^2 + dxy[2]^2]]      and other similar attempts have unfortunately ended in failure. Some sample output looks like this:                 dxy = {{{2.00946*10^8, 9.69241*10^7}}, {{2.03432*10^8,             9.83663*10^7}}, {{2.05917*10^8, 9.98081*10^7}},...}      Where, for example, the first entry shows the x and y relative position as `{2.00946*10^8, 9.69241*10^7}` and I'm trying to combine those two components into a radius. Combining the x-y position pairs into a radius using `Sqrt[x^2 + y^2]` for the first 3 position pairs given above I would get                dr = {{2.231*10^8},{2.25965*10^8},{2.2883*10^8},...}      But this was done manually for each entry and is not practical for hundreds of entries. From this list of radius positions, I can then use `Min[]` to find the closes approach point for the spacecraft relative to Mars. As can be seen below, the spacecraft gets very close to Mars (where the inner semi-circle is Earth's orbit, the outer semi-circle is Mars' orbit and the line joining the two is the spacecraft's trajectory):![enter image description here](http://i.stack.imgur.com/cLVN7.png) And if propagated further we can see that it gets close enough for Mars' gravity to affect its trajectory:![enter image description here](http://i.stack.imgur.com/MFvR3.png) So it looks pretty close, but exactly how close it what I'm hoping to find out. Any help would be greatly appreciated.


ListPlot : range from $0$

I want to plot values of a table for example:               table = {0.456, 0.7899, 1.3456, 9.8908}      But I want to Plot points (x,y) like:               (0,0.456), (1,0.7899),(2,1.3456),(3,9.8908)      And the ListPlot commend generates the plot for vaues of x from range `{1,10}`, so points like: `(1,0.456),(2,0.7899),(3,1.3456)...` How can I change to plot from $0$ points which I described?


Combine multiple notebook files into a pdf/rtf/word/etc file?

It's the end of the semester and I have a prof who wants me to turn in a printout of the nb files ive worked on. I have 33 separate files, and I was wondering if there was any easy way I could combine all of these files in batch to another nb or a document format to print out (pdf/rtf/doc/html anything really). Nothing fancy needs to happen here, basically i just need to make this into a printable file and preserve any plots i've made, and I wanted to have it all in a single file so that it's all contained to just that file. The data in these files is very simple, mainly just evaluating a problem using mathematica instead of by hand. There are no dependencies between any of the files to each other or any external libraries.


Decompose Expression into Segments

Say I have an expression `test = 3 x1^2 - 2 x3^-3` and I would like to decompose the expression into `{3 x1^2, -(2/x3^3)}`, I can do that by using `List @@ test` on Mathematica. However, the problem I face is that when the expression is `test = x1^2`, i get `{x1, 2}` and for `test = (3 x1^2)` i get `{3, x1^2}` instead of `{x1^2}` and `{3x1^2}` respectively. The added information I have is the list of variables. For example, if `test = x1^2` I have the list of variables, which is `{x1}`. And for `test = 3 x1^2 - 2 x3^-3`, I have `{x1,x3}` Is there any other way to get what I want? Thanks


Mathematica TCP socket client toward Trading Platform

I'd like to connect _Mathematica_ with my Italian electronic trading platform. To connect I need to open a TCP socket client towards the trading platform and send a string command. The high-level description (pseudo code) is like this:               - create new tcp socket on hostname="localhost and port ="5333"     - create out channel     - create input channel          - send request in string format         "function=subscribe|item=<stockCode>|schema=ask1;bid1;last_price"          - read response: if response is like outcom=OK then wait the push update          - read push update            - close socket      But how I can do this with _Mathematica_? Using JLink I should write something like this:               socket = new Socket(TCP_address, TCP_port);     out = new PrintWriter(new OutputStreamWriter(socket.getOutputStream(),     "UTF-8"));     in = new BufferedReader(new InputStreamReader(socket.getInputStream(),     "UTF-8"));     //send request to T3 .     out.println(messagge);     //Wait response      String response = in.readLine();     //[...]     //If response is outcome=OK wait push data     while(true){     String update = in.readLine();     //Thread to manage push data     }     } catch (UnknownHostException e) {     //[...]     } catch (IOException e) {     //[...]     }     //[...]      But I'd like to know if is possible to avoid java and .net !


How to work with lists of functions

I have some lists of interpolated functions and I want to know if there is an easy way to operate with them. A simplified example:               listsin = Table[FunctionInterpolation[Sin[i*x], {x, 0, 2 Pi}], {i, 1, 10}]     listlinear = Table[FunctionInterpolation[i*x, {x, 0, 2 Pi}], {i, 1, 10}]      This generates two lists of ten functions each. I want to be able to perform basic operations with these functions: sums, derivatives and products. I came up with a way that works               listsumd = Table[With[{i = i}, (listsin[[i]]'[#] + listlinear[[i]]'[#]) &], {i, 1, 10}]      But want to know if it is possible to do this without having to iterate through all the elements in the table, just by operating directly on the lists.


Creating a weighted, directed graph from ordered triples

I have a relatively large set of data that I am trying to turn into a weighted, directed graph. The data concerns the inflow of migrants based on country of origin. I currently have three columns of data in excel: a number representing country migrated to ($a_i$), a number representing country of origin ($b_i$), and the number of migrants, $n$, who have traveled from $b_i$ to $a_i$. If I turn this data into a set of ordered triples ($b_i$,$a_i$,$\sigma$) where $a_i$ and $b_i$ are as defined above, and $\sigma$ represents some sort of weight (which I will calculate based upon $n$), would it be possible to have mathematica interpret these triples as directions for constructing a graph? That is, could I somehow yield a directed graph such that each triple corresponds to an edge $b_i\rightarrow a_i$ with weight $\sigma$? Any help is appreciated.


Calculating the mean curvature of a surface - suggestions

I am attempting to calculate the mean curvature [1, 2] of a surface defined by a function of `x` and `y`. My function is rather simple:               f = 1 - 0.05(Cos[2 π x/L] + Sin[2 π x/L])Cos[2 π y/L];      So to calculate the mean curvature, this is what I do (`κ` is the mean curvature below):               L=79.1829;     f = 1 - 0.05(Cos[2 π x/L] + Sin[2 π x/L])Cos[2 π y/L];     κ=((1 + D[f,x]^2) D[f,y,y]-2 D[f,x]D[f,y]D[D[f,x],y]+       (1+D[f,y]^2)D[f,x,x])/((1 + D[f,x]^2 + D[f,y]^2)^1.5)      And then I plot it as :               (*Surface defined by f*)     Plot3D[       f,       {x, 0, L},       {y, 0, L}       ]      ![enter image description here](http://i.stack.imgur.com/yX7l9.png)                (*Plot of kappa*)      Plot3D[       κ,       {x, 0, L},       {y, 0, L}       ]      ![enter image description here](http://i.stack.imgur.com/ez4VU.png)   1. I wasn't entirely sure of whether to post this question in math.se or mathematica.se but I did so on mathematica.se since it does have a _Mathematica_ component to it.   2. Is what I am doing correct? I ask because this seems rather trivial.   3. Does anyone have any suggestion as to do this in a better way, perhaps plot it in a better way? A little background: * * * I am trying to prove quantitatively that different initial conditions created by the surface like `f` would engender different amounts of curvature for a fluid dynamics problem.


Use a pre-computed list instead of RandomInteger

I would like to replace `RandomInteger[{1, 10}, {10, 10}]` in the following code:               DynamicModule[{c = 11},        Grid[         Map[Button[ToString @ #,                     c = #,                     Background -> Dynamic[If[Mod[#, c] == 0, Green, White]],                     ImageSize -> {32, 32},                     Appearance ->  "Frameless"] &,            RandomInteger[{1, 10}, {10, 10}],           {2}],          Frame -> All,          FrameStyle -> Directive[GrayLevel[0.8], Dashed],          Spacings -> {.2, .2}]]      with a series of lists; e.g., `Transpose @ Partition[Range @ (10*10), 10]`.


How can I shift from one window to another window?

I am building a cdf application,which has multiple screens,every screen was linked to another screen. Right now I am using `CreateDialog`. Are there any other options of displaying multiple screens to users?


Importing 2d array of files

I would like to import multiple files to a 2d array. I know to get a list of files I can do               myfiles=FileNames["*.txt"]     alldata=Import/@myfiles      Is it possible to get my data files in a 2d array if, for example, my files look like               myfiles={file11.txt,file12.txt,file21.txt,file22.txt}      where the numbers in the filenames correspond to an x and y index. I have done this using for loops. Is there a more functional way?


No warning when extrapolating with Plot

One of the most annoying "features" of Mathematica is that the `Plot` family does extrapolation on `InterpolatingFunction`s without any warning. I'm sure it was discussed to hell previously, but I cannot seem to find any reference here in _Mathematica_.SE. While I know how to simply overcome the problem by defining a global variable for the domain of the interpolation, from time to time I forget to do this and then I spend days figuring out where does the numerical error originate. This can be avoided if `Plot` was to give a warning. Consider the following example. An ODE system is defined and integrated for two different time ranges:               odes = {        a'[t] == -a[t] - .2 a[t]^2 + 2. b[t],         b'[t] == a[t] + .1 a[t]^2 - 1.1 b[t], a[0] == 1, b[0] == 1     };     sol100 = First@NDSolve[odes, {a, b}, {t, 0, 100}];     sol500 = First@NDSolve[odes, {a, b}, {t, 0, 500}];      Now querying the function value for a point outside of the range gives a correct warning:               (a /. sol100)[500]      > >     InterpolatingFunction::dmval: Input value {500} lies outside >     the range of data in the interpolating function. Extrapolation will be > used. >> >   >     651.034 >   The same is not done when we use the function in `Plot`:               Show[      Plot[{a[t], b[t]} /. sol100, {t, 0, 400}, PlotStyle -> {Thick, Red}],      Plot[{a[t], b[t]} /. sol500, {t, 0, 500}, PlotStyle -> {Thick, Blue}]      ]      ![Mathematica graphics](http://i.stack.imgur.com/X7xaL.png) I've tried to force a warning, with no avail. The following example still does not drop a warning, and returns the same plot and not `"Error"`.               On[InterpolatingFunction::dmval]     Check[Plot[{a[t], b[t]} /. sol100, {t, 0, 500}], "Error",       InterpolatingFunction::dmval]      Interestingly, one can be sure that `InterpolatingFunction::dmval` is NOT turned off at all inside the `Plot` family. In the following example, `LogLinearPlot` is able to drop a warning about sampling from below the domain (that can be ignored being unrelated, see this post, also it seems to be fixed in v9), but it does not drop the same warning when sampling from **above** (> 100)!               LogLinearPlot[{a[t], b[t]} /. sol100, {t, 0.1, 500}]      > >     InterpolatingFunction::dmval: Input value {-2.30241} lies outside the >     range of data in the interpolating function. Extrapolation will be used. > >> >   It is even more disturbing to see that `Plot` checks the lower boundary but not the upper (thanks to J.M. for the comment):               Plot[{a[t], b[t]} /. sol100, {t, -1, 500}]      > >     InterpolatingFunction::dmval: Input value {-0.989765} lies outside the >     range of data in the interpolating function. Extrapolation will be used. > >> >   As Oleksandr has pointed out, it is not about lower vs. upper bound but first point vs. the rest.               Plot[{a[t], b[t]} /. sol100, {t, 101, 500}]      > >     InterpolatingFunction::dmval: Input value {101.008} lies outside the >     range of data in the interpolating function. Extrapolation will be used. > >> >   ## **Questions**   1. Why `Plot` does not give a warning when extrapolating an `InterpolatingFunction`? Is there some higher-level consideration that justifies this behaviour, or is it a higly annoying feature that is surely unexpected in most cases (maybe a bug)?   2. How can one force `Plot` to give a warning? Is there any workaround that forces InterpolatingFunction::dmval not to be attenuated inside `Plot`?  Please note that I am not interested in solutions that make sure that I use the same value for integration and for plotting (i.e. defining a global `time` variable). I want to make sure that `Plot` NEVER extrapolates without giving a warning.


Get subgraphs: communities of graph g

I have a graph `g`. I want a set of graphs `c` which holds the community subgraphs of `g`. I tried `c = Subgraph[g, FindGraphCommunities[g]]`, but it only outputs the whole graph `g`. I see in the documentation that `FindGraphCommunities` returns a list of vertices, this may be why. How do I also get the edges?


Semi prime numbers

The high school textbook I am using has the example of semi-prime numbers. They wanted students to find (by "perspiration") all the semi-prime numbers less than $50$ (for a question on set theory). A semi-prime number is the product of exactly two prime numbers (not necessarily distinct). How would I generate the first $n$ semi-prime numbers using _Mathematica_?


How can I plot Intensity values(Z) based on X and Y position. Data stored as 3 columns in CSV file

I have a CSV data file with `X` position, `Y` position and corresponding intensity as `Z`. I would like to plot it to form an image. I have an idea that list density plot is one method,but, somehow the importing of the CSV file as table and plotting is resulting in an error :               Read::readn: "Invalid real number found when reading from "test2 10 10.csv."      I am totally new to Mathematica and just learning. I don't understand why it takes so long to even import a CSV file. Thanks !


How to find the variance under the assumption that x follows some probability distribution

I am aware that we can find the expectation under the assumption that x follows some probability distribution, something like this:               Expectation[((1 - x)/x), x \[Distributed] BetaDistribution[alpha, beta]]      However, is it possible to find the variance of the above equation (1-x)/x under the same assumption that x follows a beta distribution?


NExpectation not up to expectations with Boole or Conditioned

_Context_ I am interested in computing numerically the number of extrema at a given threshold for random fields. These numbers are expectations of MultinormalDistributions. _Problem_ This integral should give the differential number of maxima of a scale invariant Gaussian random field ($\gamma=0$ i.e. white noise) at threshold zero.               NExpectation[(-(x*y) + z^2)*Boole[x*y - z^2 <= 0],      {x, z, y} \[Distributed]      MultinormalDistribution[{0, 0, 0}, {{3/8, 0, 1/8}, {0, 1/8, 0}, {1/8, 0, 3/8}}]]      Its value should be `1/4/Sqrt[3]= 0.144338` whereas Mathematica returns 0.138245 which is wrong by a factor of 5 %. Strangely enough if I split the integral in two as               NExpectation[(-(x*y) + z^2)*Boole[x + y >= 0 && x*y - z^2 <= 0],       {x, z, y} \[Distributed]       MultinormalDistribution[{0, 0, 0},{{3/8, 0, 1/8}, {0, 1/8, 0}, {1/8, 0, 3/8}}]] +     NExpectation[(-(x*y) + z^2)*Boole[x + y <= 0 && x*y - z^2 <= 0],        {x, z, y} \[Distributed]      MultinormalDistribution[{0, 0, 0}, {{3/8, 0, 1/8}, {0, 1/8, 0}, {1/8, 0, 3/8}}]]      Mathematica returns the correct answer to 5 digits. I understand integrating numerically Boole is likely to cause problems but I am nonetheless surprised by the poor result. On a related topic                NExpectation[-(x*y) + z^2 \[Conditioned] (x*y - z^2 < 0),       {x, z, y} \[Distributed]       MultinormalDistribution[{0, 0, 0}, {{3/8, 0, 1/8}, {0, 1/8, 0}, {1/8, 0, 3/8}}]]      seems to take a while before returning unevaluated (even though it should probably be the correct way to proceed?). **Questions**   1. Why is the first method doing so poorly?   2. Why is the second method failing altogether?   3. Any guidance on how to tell NExpectation to be "smart" about the Boole condition? Thanks Regards


Problem with hole filling using filledCurveToPolygons3D in MMA 10

I successfully used the `filledCurveToPolygons3D` function to create `Graphics3D` text in MMA 9 on a Windows 7 PC; see: How can I create a 3D FilledCurve object? However, when I installed MMA 10 on this very same machine and tried using this technique again, all the holes in the text are filled. I tried using the recommended changes to the RHS of `processHoles` that another user had had with MMA 9 on a Mac, but I still ended up with all the holes filled. The same problem shows up as well with the 2D function `filledCurveToPolygons`.


Conditional expression

How do I evaluate a conditional expression in order to convert the solutions that are in terms of $x$ to a new variable $c$ depending on $x$? The conventional method I have been using with eliminate doesn't work in this case, because the solution is not a simple inequality, but rather conditional.                f[x_] := x^2 + c;      g[x_] := f[f[x]];      y = Solve[g'[x] == 1, x, Reals]      output is:               {{x -> ConditionalExpression[Root[-1 + 4 c #1 + 4 #1^3 &, 1],      c > -(3/4) || c < -(3/4)]},       {x ->  ConditionalExpression[Root[-1 + 4 c #1 + 4 #1^3 &, 2],  c < -(3/4)]},       {x ->  ConditionalExpression[Root[-1 + 4 c #1 + 4 #1^3 &, 3],  c < -(3/4)]}}           Eliminate[c == -x - x^2 && x == y[1], x]


ErrorBars/ other way of visualising deviation in Paired Bar Charts (PBC)

Data:   * three categories A,B,C   * values in each category: `{median-semiIQR, sIQR (such that this value = median), sIQR (such that this value = median + sIQR)}` e.g. `{{90, 21, 21}, {57, 14, 14}, {117, 69, 69}}` What I want: Preferably, just bar indicating the median value, then an errorbar added, indicating the sIQR, but how is this done in a PBC? Else: cat. A is Red, cat. B Blue and cat. C Green. The last two values of each category have to be Blended, so that they are Pinkish, Lightblueish and LightGreenish, to indicate that these are sIQRs. In addition, I would like to display the median value for each category


How do I find the maximum value from the given set of data?

I have a set of data like `{{x1, y1},{x2, y2}, ...,{xn, yn}}`.   From this data can I find the value of `x` for which `y` is maximum.   Is it is possible using _Mathemamtica 9.0_?


3D Random Walk with Periodic Boundary Conditions

I am working on a 3D random walk with periodic boundary conditions and have written a program that will do this for me but it is extremely slow. Does anyone have any suggestions on how I could speed this up?               Timing[      n = 1.;      T = 10000.;      boundary = 5;      initial = boundary;      step = 0.1;      RandomWalk[x_] :=        Accumulate[        Join[{Table[RandomReal[{-initial, initial}], {3}]},          RandomVariate[NormalDistribution[0, step], {x, 3}]]];       i = 1;      (Label[begin];       p[i] = RandomWalk[T + 1];       If[i == n, Goto[end]];       i = i + 1;       Goto[begin];       Label[end];);      t = 0;      (Label[begin1];       i = 1;       Label[begin2];       positionslist = p[i];       If[p[i][[t + 1, 1]] > boundary,         p[i] = Join[Take[positionslist, t + 1],           Accumulate[           Join[{{-boundary, p[i][[t + 1, 2]], p[i][[t + 1, 3]]}},             RandomVariate[             NormalDistribution[0, step], {T - t + 1, 3}]]]]];       If[p[i][[t + 1, 1]] < -boundary,         p[i] = Join[Take[positionslist, t + 1],           Accumulate[           Join[{{boundary, p[i][[t + 1, 2]], p[i][[t + 1, 3]]}},             RandomVariate[             NormalDistribution[0, step], {T - t + 1, 3}]]]]];       If[p[i][[t + 1, 2]] > boundary,         p[i] = Join[Take[positionslist, t + 1],           Accumulate[           Join[{{p[i][[t + 1, 1]], -boundary, p[i][[t + 1, 3]]}},             RandomVariate[             NormalDistribution[0, step], {T - t + 1, 3}]]]]];       If[p[i][[t + 1, 2]] < -boundary,         p[i] = Join[Take[positionslist, t + 1],           Accumulate[           Join[{{p[i][[t + 1, 1]], boundary, p[i][[t + 1, 3]]}},             RandomVariate[             NormalDistribution[0, step], {T - t + 1, 3}]]]]];       If[p[i][[t + 1, 3]] > boundary,         p[i] = Join[Take[positionslist, t + 1],           Accumulate[           Join[{{p[i][[t + 1, 1]], p[i][[t + 1, 2]], -boundary}},             RandomVariate[             NormalDistribution[0, step], {T - t + 1, 3}]]]]];       If[p[i][[t + 1, 3]] < -boundary,         p[i] = Join[Take[positionslist, t + 1],           Accumulate[           Join[{{p[i][[t + 1, 1]], p[i][[t + 1, 2]], boundary}},                 RandomVariate[             NormalDistribution[0, step], {T - t + 1, 3}]]]]];       If[i == n, Goto[end2]];       i = i + 1;       Goto[begin2];       Label[end2];       If[t == T, Goto[end1]];       t = t + 1;       Goto[begin1];       Label[end1];);]               {9.44905, Null}      I would like to do this simulation for multiple particles (at least 50) for about 100000 time steps and not have it take all day.


Finding the Minimum value of an interpolating function

I can't seem to use `FindMinValue` to find the min. value of a curve represented by an interpolating function. For instance the below code generates an interpolating function polynomial as the solution of the heat equation.               tsol = u /.        NDSolve[{D[u[t, x], t] == D[u[t, x], x, x], u[0, x] == 0,           u[t, 0] == Sin[t], u[t, 5] == 0}, u, {t, 0, 10}, {x, 0, 5}][[1]]      This plots it:               Plot3D[Evaluate[u[t, x] /. %], {t, 0, 10}, {x, 0, 5},       PlotRange -> All]      ![enter image description here](http://i.stack.imgur.com/yfXqT.png) I'd like to find the minimum point in the curve represented by this function at say, `t=10.0`, , so I try doing this:               FindMinValue[tsol, {{x, 0, 5}, {t, 0, 10}}]      Which is obviously wrong. I'd like to find the minimum value AT t=10. This didn't work either:               FindMinValue[tsol[10, x], {x, 0, 5}]      I actually have an interpolating func. which is in `x` `y` and `t` and I am quite flabbergasted. Why is the Dimensions of `tsol` 5? I thought it'd be 2 since it is only in x and t. Plot of tsol[10,x]: ![enter image description here](http://i.stack.imgur.com/YA3BV.png)


Force Mathematica not to reduce a fraction

I am interested in a function which would stop _Mathematica_ reducing fraction. If my input is `50/100`, _Mathematica_ outputs `1/2`, I want it to output `50/100`. Any nice function which does this? I need this because I want to define a recursive function with this behavior:               f[0]=50/100     f[n_]:=(Numerator[f[n-1]]+1)/(Denominator[f[n-1]]+1)      I want to obtain `f[1]=51/101`, not `f[1]=2/3`, which I get. A more complicated example:               f[0]=50/100     f[n_]:=If[Mod[n,2]==0,(Numerator[f[n-1]+1])/n,Numerator[f[n-1]/(Denominator[f[n-1]]+1)      This gets really annoying if I store 50/100 as {50,100}.


Can I store a DataDistribution in a database?

I have a `DataDistribution`               data = KernelMixtureDistribution[RandomVariate[NormalDistribution[], 10^5]]       that takes a long time to calculate because of database operations. I don't need to constantly recalculate the distribution, so I'd like to store it in a database, and recalculate it at intervals. The documentation for `SQLBinary` refers to `ExportString`, which seems focused on graphics and doesn't have a generic format. Nor does `StringTake` work on a `DataDistribution`. So, how can I store a `DataDistribution` in an SQL database? EDIT: Thank you again Andy Ross! Here's my solution in the end. creating a string version of a data distribution.               inform = kern // InputForm;     ToString[inform]      Then I save it into an SQL database with `SQLInsert`. Next, to extract it back to usable form:               ToExpression[ ToString[sqlkern] , InputForm]


How do you show a cone inside of a sphere?

I have a sphere of radius 5 and a cone (i.e. z=√(x^2+y^2)) inside of it. I can show them separately, but I'd like to show them together. I've tried a few tricks with opacity, implicit specifications, show, and range changes, but nothing is giving me a satisfying result. Really I'd like to show the "ice cream cone" shape by itself, but I'd settle for a cone under a hemisphere right now. Anyone know how I can get this done? Thanks in advance


Why does Integrate set the constant of integration to be one in this case?

Why does                Integrate[(4 x)/(2 x + 1), x]      give                1 + 2 x - Log[1 + 2 x]      Notice the extra `1`. The answer should be `2 x - Log[1 + 2 x]` plus the constant of integration. But Integrate never gives a constant of integration.                Integrate[4 x, x]      (2 x^2*)      Actually, here is the answer by Rubi:                Int[(4 x)/(2 x + 1), x]      (* 2 x - Log[1 + 2 x] *)      And by Maple ![Mathematica graphics](http://i.stack.imgur.com/iAhtu.png) and by Wolfram Alpha ![Mathematica graphics](http://i.stack.imgur.com/Y5saL.png) I restarted the kernel, restarted _Mathematica_. Same answer. Using V 9.01 on windows 7. ![Mathematica graphics](http://i.stack.imgur.com/CkMtg.png) Any idea what is going on? Is this a known feature/issue? One can of course argue that the answer is not wrong, since the constant of integration can be any value, but it is strange that it shows up here only, and with a specific value.


Asymptotic expansion on 3 nonlinear ordinary differential equations

The 3 nonlinear differential equations are as follows \begin{equation} \epsilon \frac{dc}{dt}=\alpha I + \ c (-K_F - K_D-K_N s-K_P(1-q)), \nonumber \end{equation}   \begin{equation} \frac{ds}{dt}= \lambda_b P_C \ \epsilon \ c (1-s)- \lambda_r (1-q) \ s, \nonumber \end{equation} \begin{equation} \frac{dq}{dt}= K_P (1-q) \frac{P_C}{P_Q} \ \ c - \gamma \ q, \nonumber \end{equation} I want to use asymptotic expansion on $c, s$ and $q$. And values of parameters are: $K_F = 6.7 \times 10^{-2},$   $K_N = 6.03 \times 10^{-1}$ $K_P = 2.92 \times 10^{-2}$, $K_D = 4.94 \times 10^{-2}$, $\lambda_b= 0.0087$, $I=1200$ $P_C = 3 \times 10^{11}$ $P_Q = 2.304 \times 10^{9}$ $\gamma=2.74 $ $\lambda_{b}=0.0087 $ $\lambda_{r}= 835$ $\alpha=1.14437 \times 10^{-3}$ For initial conditions: \begin{equation} c_0(0)= c(0) = 0.25 \nonumber \end{equation} \begin{equation} s_0(0)= cs(0) = 0.02 \nonumber \nonumber \end{equation} \begin{equation} q_0(0)=q(0) = 0.98 \nonumber \nonumber \end{equation} and \begin{equation} c_i(0)= 0, \ i>0\nonumber \end{equation} \begin{equation} s_i(0)= 0, \ i>0 \nonumber \nonumber \end{equation} \begin{equation} q_i(0)=0, i>0\. \nonumber \nonumber \end{equation} => i started with the expansions : \begin{equation} c= c_0+ \epsilon c_1 + \epsilon^2 c_2+......... \nonumber \end{equation} \begin{equation} s= s_0+ \epsilon s_1 + \epsilon^2 s_2+......... \nonumber \end{equation} \begin{equation} q= q_0+ \epsilon q_1 + \epsilon^2 q_2+......... \nonumber \end{equation} we are only interseted in up to fisrt power of $\epsilon$. so, we should get total 6 approximate differential equations to get answer for $\frac{dc_0}{dt}, \frac{ds_0}{dt}, \frac{dq_0}{dt}, \frac{dc_1}{dt}, \frac{ds_1}{dt}$ and $\frac{dq_1}{dt}$ but i think $\frac{dc_1}{dt}$ will disappear while expanding and equating the up to first power of $\epsilon$, do i need to go further up to $\epsilon{^2}$ because $\frac{dc_1}{dt}$ is very important to find and we need 6 approximate differetial equations in total. what can i do? please some one help me.


Heron's formula for area of a triangle

> Use the first form of Heron's formula to give a function `areah`, which > gives the area of a triangle. Test your answer on the isosceles triangle > `{{-1 ,0}, {1, 0}, {0, 1}, {-1, 0}}`. This is what I have:               areah[triangle_] :=       (lenbroke[triangle]/2 Product[lenbroke[triangle]/2 -         len (lineseg (triangle[[i]])), {i, 1, 3}])      This is what I get when I test it:               areah[{{-1, 0}, {1, 0}, {0, 1}, {-1, 0}}]      I don't know what is wrong because when I test it, it doesn't work.


Converting in various currencies

I was just playing around with _Mathematica_ converting some currencies:               UnitConvert[Quantity[1, "\[Euro]"], "ISK"]     UnitConvert[Quantity[1, "\[Euro]"], "£"]     UnitConvert[Quantity[1, "£"], "\[Euro]"]     UnitConvert[Quantity[1, "$"], "\[Euro]"]     UnitConvert[Quantity[1, "BitCoin"], "\[Euro]"]     UnitConvert[Quantity[1, "BitCoin"], "$"]      ![outputs](http://i.stack.imgur.com/xj203.png) I was surprised about the outputs #23 and #24. Why can't _Mathematica_ convert them like the rest? So I should take the factor BTC/USD: WolframAlpha says: ![enter image description here](http://i.stack.imgur.com/bq19i.png) ![enter image description here](http://i.stack.imgur.com/uQhPu.png) Why aren't BitCoin rates shown by `UnitConvert`? And btw: Is there a shortcut for the BitCoin symbol in _Mathematica_? Here is what I found out about the symbol/shortcut **EDIT and WARNING:** Do NOT copy/paste the BitCoin sign (฿) from the output!!! It's not interpreted as Bitcoins by _Mathematica_ :               Quantity[371.57, "\[Euro]/฿"]      ![enter image description here](http://i.stack.imgur.com/WKr8s.png) ![enter image description here](http://i.stack.imgur.com/DHnFr.png) _Mathematica_ gives the same symbol for BitCoin and ThaiBaht!               Quantity[1, "฿"]     Quantity[1, "ThaiBaht"]     Quantity[1, "BitCoin"]      ![enter image description here](http://i.stack.imgur.com/D0cI3.png) BUT               UnitConvert[Quantity[1, "฿"], "\[Euro]"]     UnitConvert[Quantity[1, "TahiBaht"], "\[Euro]"]     UnitConvert[Quantity[1, "BitCoin"], "\[Euro]"]      ![enter image description here](http://i.stack.imgur.com/UUDdP.png)


Combining the second elements of a set of ordered pairs based on their first element

I have a large set of ordered pairs and I am trying to add the second elements together for any group of pairs that has the same first element. For example my data looks like:               data={{1,2},{1,3},{2,3},{3,2},{3,6}}      and I want to return something like:               newdata={{1,5},{2,3},{3,8}}      I figured out how to group the data based on their first element using `GatherBy[data,{First}]`, but I'm not sure where to go from there. I feel like there is probably a much easier way than that, but it is evading me.


Merging lists and adding common elements

I have two 2D arrays where some of the x-values are identical,               L={{1,1},{2,2},{3,3}};     J={{0,1},{2,2},{4,4}};      I want to add these lists in the following way               {{0,1}, {1,1},{2,4},{3,3},{4,4}};      In other words, that y-values of the data points that have the same x are added. How can I achieve this? * * * **Please note that the arrays are not necessarily of the same length** Two arrays for test:               first = {{0.15, 0.000470185}, {0.16, 0.000521784}, {0.17, 0.000580663}, {0.18,        0.000648083}, {0.19, 0.000725569}, {0.2, 0.000814968}, {0.21,        0.000918532}, {0.22, 0.00103901}, {0.23, 0.0011798}, {0.24,        0.00134508}, {0.25, 0.00154005}, {0.26, 0.00177121}, {0.27,        0.00204667}, {0.28, 0.00237667}, {0.29, 0.00277409}, {0.3,        0.00325523}, {0.31, 0.00384059}, {0.32, 0.00455591}, {0.33,        0.00543312}, {0.34, 0.00651098}, {0.35, 0.00783476}, {0.36,        0.00945361}, {0.37, 0.0114133}, {0.38, 0.0137402}, {0.39,        0.0164132}, {0.4, 0.0193217}, {0.41, 0.0222235}, {0.42,        0.0247384}, {0.43, 0.0264243}, {0.44, 0.0269371}, {0.45,        0.0261818}, {0.46, 0.024341}, {0.47, 0.0217652}, {0.48,        0.0188176}, {0.49, 0.0157753}, {0.5, 0.0128044}, {0.51,        0.00998009}, {0.52, 0.00731676}, {0.53, 0.00479353}, {0.54,        0.00237078}, {0.55, 0}}               second = {{-0.04, -0.0000547619}, {-0.03, -0.000405238}, {-0.02, -0.00207438}, \     {-0.01, -0.00878929}, {0, -0.0154401}, {0.01, -0.0178195}, {0.02, \     -0.0180879}, {0.03, -0.0173267}, {0.04, -0.0157714}, {0.05, \     -0.014605}, {0.06, -0.0131757}, {0.07, -0.0119764}, {0.08, \     -0.010695}, {0.09, -0.00946286}, {0.1, -0.00849357}, {0.11, \     -0.00708071}, {0.12, -0.00578286}, {0.13, -0.00468214}, {0.14, \     -0.00306119}, {0.15, -0.00146214}, {0.16, 0.00061881}, {0.17,        0.00194733}, {0.18, 0.00376762}, {0.19, 0.00509833}, {0.2,        0.00625381}, {0.21, 0.00762286}, {0.22, 0.00918905}, {0.23,        0.0105964}, {0.24, 0.0118067}, {0.25, 0.0134238}, {0.26,        0.0149774}, {0.27, 0.0163519}, {0.28, 0.017469}, {0.29,        0.0167517}, {0.3, 0.0102788}, {0.31, 0.00253876}, {0.32,        0.000314333}, {0.33, 0.000038881}, {0.34, 0.0000224524}}      * * * first array is here: http://www.datafilehost.com/d/731a267e. The second array I generate from this code:               factor = 11.0;     second = Table[{(38 - i)*0.01, 0}, {i, 0, 38}] - 0.04;     tempData = (1/10000) (factor/21) {         0.41,         0.71,         5.74,         46.36,         187.70,         305.90,         319.0,         298.60,         273.50,         245.13,         215.60,         193.50,         167.80,         139.20,         114.20,         93.10,         68.80,         35.56,         11.30,         -26.70,         -55.90,         -85.50,         -105.60,         -129.30,         -155.10,         -172.80,         -195.30,         -218.70,         -240.60,         -266.70,         -288.00,         -316.4,         -330.3,         -325.4,         -281.95,         -160.50,         -37.88,         -7.4,         -1.0         };          For[i = 1, i < Length[tempData] + 1, i++,       second[[i, 2]] = tempData[[i]]];     second = second // Reverse;


Given a list of pairs, average the second elements of pairs whose first elements match

Say this is my list:               mylist={{1,4},{1,6},{1,11},{2,12},{2,14}}      I want to do an operation that looks at the first element of each pairs, and for all those that match, average their second elements, and put that "first element and averaged second elements" pair in a new list. So my final product would be:               newlist={{1,7},{2,13}}      A caveat however is that the first elements are not obvious integers like in my example. They could be any number and would not easily be iterated over as they would be in my example. I imagine I could do this with loops but I was wondering if there was a more elegant Mathematica "list-manipulation" way. Thank you!


Filter through list and lump data

I have a very large data set (around 3000) that looks like:               {{1749.08, 580.}, {1749.17, 626.}, {1749.25, 700.}, {1749.33,        557.}, {1749.42, 850.}, {1749.5, 835.}, {1749.58, 948.}, {1749.67,        663.}....      The first number is the year plus the month/12. So I want to iterate over all the list adding the second part for each year So example using data above: `For year 1749: 580+626+700+557+850+835+948+663` I know I have to use a for loop but I can't figure out the syntax. Can anyone lend a helping hand?


Re-arranging / selecting of a data table very slow in For loop

My task is quite simple; I have a table of data like               M = {{1,2}, {1,3}, {3,4}, {5,1}, {6,9}, {6,8}, {6,1}};      so the table is sorted with respect to the first entry of each tuple. What I want is basically to gather tuples with the same 'x' entry in a new one. M would look like this:               M = {{1,(2+3)/2}, {3,4}, {5,1}, {6,(9+8+1)/3}};      This can be possibly solved elegantly with some gathering and application of summation and counting, but since I'm a C speaker, I've taken the For loop as my first try:               Stringed = ConstantArray[{-1., -1.}, Dimensions[StoreFlat][[1]]]; (* this is     the array where all the data will be stored in. StoreFlat is the sorted but     "uncollected" input *)     Module[{i = 1, j = 1, k = 1, a = 1., f = 1.},       Monitor[        For[i = 1, i <= Dimensions[StoreFlat][[1]], i++, (* loop over the number of tuples *)         If[i == 1, (* first entry *)          f = StoreFlat[[1, 1]];          a = StoreFlat[[1, 2]];,          If[f == StoreFlat[[i, 1]], (* a tuple exists already with this entry *)            a += StoreFlat[[i, 2]];            k++;,            f = StoreFlat[[i, 1]]; (* this entry is larger than the former one *)            a = StoreFlat[[i, 2]];            j++; k = 1;            ];          ];         Stringed[[j]] = {f, a/k}; (* output. the second entry is divided by the number of     entries. *)         ],        ProgressIndicator@N[i/Dimensions[StoreFlat][[1]]]        ]       ];      I know that this is probably not the fastest way. But since my input is not too larger (190 000 tuples of a real, floating point value) this should do the job. Is anything wrong about my approach? On my laptop, this thing takes a lot of time (10 to 20 minutes, I guess - I cancelled it).


From a list of (x,y) pairs, generate a new list of (x,ymean) pairs, where ymean is the average of all y's with the same x in the original list

This seems like the sort of thing where _Mathematica_ can give a very simple solution. I have a list of points `{x,y}`:               {{1, 2}, {1, 3}, {1, 4}, {2, 3}, {2, 4}, {3, 5}}      From this list, I want to generate a new list of pairs `{x,ymean}`, where `ymean` is the average of all `y`'s in the original list which were paired to the same value of `x`:               {{1, 3}, {2, 7/2}, {3, 5}}      What's the simplest, most elegant way to accomplish this in Mathematica?


Question about the matrix operation

I was wondering if there is an automatic way to do this kind of matrix operation. For example, for a given matrix               list = {{1, 3T}, {3, 8T}, {2, 2T}, {1, 5T}, {4, 6T}};        I want the result to be like this as shown below after the operation.               result = {{1 ,8T}, {2, 2T}, {3, 8T}, {4, 6T}}      The operation will add the terms in the second column if they have the same number in the first column for all the rows. i.e. for the first row, the second term is calculated as `3T` plus `5T`,which is the term in `list[[4,2]]`.


Total elements of a list that have a common first element

> **Possible Duplicate:**   >  List-operations only when restrictions are fulfilled (Part 1) I have a set of data like:               list = {{Tim, 45},{Mary,100},{Tim,500},{Bob,499},{Mary,50}};      I'm looking for a simple way to total the values based off of the name so that the output would look like: `{{Tim,545},{Mary,150},{Bob,499}}`


List-operations only when restrictions are fulfilled (Part 1)

Consider the following:               data={{{3542313600, 175}, {3542918400, 175}}, {{3544128000, 450},     {3544128000, 450}, {3545337600, 450}, {3545942400, 450}, {3546547200, 450}}};      whereas the first element of each `{_,_}` represent a date in absolute time, i.e. `{_,_}` corresponds to the pattern `{AbsoluteDate_,Value_}`. Now I would like to calculate the sum of all `Value_` when the corresponding `AbsoluteDate_` is equal, e.g. `{3545337600, 450}, {3545337600, 450}`-> `{3545337600, 900}`.


Sorting a table of vectors with weights

I'm trying to simplify a table, for instance               {{1, {4, 2, 0}}, {4, {2, 4, 0}}, {-2, {3, 3, 0}}, {1, {3, 0, 3}}, {-3, {0, 4, 2}}}      Here the first column is the "weight" of the corresponding vector in the second column. In the specific problem, the ordering of the entries in the vectors in the second column do not matter, so these can be sorted. I then want to gather the vectors, such that ones that are equivalent only appear once. In the process, I want to sum the weights. For instance, in the above example, the result would be               {{2, {4, 2, 0}}, {-1, {3, 3, 0}}      Any help would be greatly appreciated!


How can I fit a matrix function with multiple variables to given eigenvalues?

I have a 5x5 matrix function `H[kx]`               H[kx_]:={{T1, kx T8, -I T6, kx T9, -I kx T10},       {kx T8, T2, -I kx T11, kx T12, I kx T13},       {I T6, I kx T11, T3, -I kx T14, kx T15},       {kx T9, kx T12, I kx T14, T4, -I T7},       {I kx T10, -I kx T13, kx T15, I T7, T5}     }      with real parameters `T1` to `T15`, and I have data as follow               dat={{-0.005, -0.418971, 1.24115, 2.6321, 3.07757, 4.40013},       {-0.004, -0.418735, 1.24086, 2.63201, 3.07785, 4.40028},       {-0.003, -0.418551, 1.24063, 2.63194, 3.07806, 4.4004},       {-0.002, -0.41842, 1.24047, 2.63189, 3.07822, 4.40048},       {-0.001, -0.418342, 1.24038, 2.63185, 3.07831, 4.40053},       {0., -0.418316, 1.24034, 2.63184, 3.07834, 4.40055},       {0.001, -0.418342, 1.24038, 2.63185, 3.07831, 4.40053},       {0.002, -0.41842, 1.24047, 2.63189, 3.07822, 4.40048},       {0.003, -0.418548, 1.24063, 2.63194, 3.07807, 4.4004},       {0.004, -0.418728, 1.24085, 2.63201, 3.07785, 4.40028},       {0.005, -0.418959, 1.24114, 2.63211, 3.07758, 4.40012}     }      For each `i`, `kx=dat[[i,1]]`, and `dat[[i,2;;6]]` are the eigenvalues (from small to big) which will be fitted by `H[kx]`. The aim is to find all the parameters `T1` to `T15` which best produce the eigenvalues given by `dat` for all `kx`. How can I achieve this?


What is the point of Refresh if Dynamic has an UpdateInterval option?

I haven't found an example where I can't get rid of Refresh[]:               In[1]:= Dynamic[DateString[],UpdateInterval->1]     Out[1]= Sat 10 Nov 2012 01:36:34     In[2]:= Dynamic[Refresh[DateString[],UpdateInterval->1]]     Out[2]= Sat 10 Nov 2012 01:36:34


How to colorize a rectangle with a given color function?

I want to set color to a rectangle (in fact a line) that lies on (0,0) and (1,0), and the color function is given by $u(x,t)=t(x-x^2), 0\leq t\leq1$. Since, this $u(x,t)$ act as temperature at the point $(x,0)$ at time $t$, I want to use the colordata with "TemperatureMap", the following is what I have tried:               u[x_, t_] := t (x - x^2)     Animate[Plot[0, {x, 0, 1},       AxesOrigin -> {0, 0},       PlotRange -> {{0, 1}, {-0.02, 0.25}},       PlotStyle -> {Thick},       ColorFunction -> (ColorData["TemperatureMap"][u[#, t]]) &],     {t, 0, 1}]      I find that it must be some problem in the ColorFunction, but I can't fix it, any suggestion? * * * I have tried your code, and find it shall works as the first answer, but since my original question (not posted here) is tried to solving the following question,               f[x_] := -x^2 + x     equ = {D[u[t, x], t] == D[u[t, x], x, x],     u[0, x] == f[x],     u[t, 0] == f[0],     u[t, 1] == f[1]};     sol = NDSolve[equ, u, {t, 0, 1}, {x, 0, 1}]     HeatConda = Animate[Show[{     Plot[Evaluate[u[t, x] /. sol], {x, 0, 1},       PlotRange -> {-0.1, 0.25}, AxesOrigin -> {0, 0},       Filling -> Axis,       ColorFunction -> (ColorData["TemperatureMap"][#2] &)],     Plot[-0.04, {x, 0, 1}, PlotStyle -> {Thick},      ColorFunction ->       Function[{x, y},         ColorData["TemperatureMap"][Evaluate[u[t, x] /. sol]]]]}],      {t, 0, 0.4}]      I want to color the **bottom line** as the same as the filling color. I first tried to simplify the question to the one post here, but the solution here still can work for my (original) question, so please help me again? ![The Figure](http://i.stack.imgur.com/8AEbs.png)


ParametricNDSolveValue or NDSolve + fitting

I have been trying to find the value for the parameter `kestim` that yields the best fit of a model to some data points. `datac` has **25 data points** , but I illustrate with just a few. I tried to do the fitting after using `ParametricNDSolveValue`:               datac={{0,73},{300,605},{600,1244},{900,1874},{1200,2000},{1500,2900},{1800,3300}};          pfun = ParametricNDSolveValue[{       [MODEL]       } /. parameters,       {G,T,H,Y,U},       {t, 0, 7200}, {kestim}]               (*because variable Y is the one I am interested, I specify it in the next command*)     f[x_]:=pfun[x][[4]]               (*I evaluate `f[1.1][600]` I get the correct value of variable `Y`. I then fit it to the data.*)     fit = NonlinearModelFit[datac, f[kestim][t], {kestim}, {t}]      Yet, I get the error `Part::partw: "Part 4 of \!\(\*TagBox[RowBox[{\"ParametricFunction\" [etc etc] does not exist.>>` and the output `FittedModel[InterpolatingFunction[{{0.,7200.}},<>][t]]`. From the latter I am able to extract the value of `kestim`, although the value obtained for this parameter is not significant. I know I am not providing enough information, but I really cannot show my model here. Yet, do you think you could help me find what I am doing wrong? Thank you so much! **Edit** : What was going wrong was probably the `ReplaceAll` inside `pfun`. Now it is working. I provide a draft version of the model below:               pfun = ParametricNDSolveValue[{       G'[t] == 50 - 6*^3 T[t] G[t], G[0] == 0,       T'[t] == 73 H[t] - 11 T[t], T[0] == 25000,       H'[t] == ke (1 - T[t] - H[t]) - 73 H[t], H[0] == 0       },       {G,T,H},       {t, 0, 7200}, {ke}];               (*as per suggestion of @ruebenko*)     f[ke_?NumericQ] := pfun[ke][[3]]          f[1.1][600]     (*Out=0.0135135*)


Forcing a graph not to resize

This code:               Clear[ighamiltMol,timeList,hamiltMol,];          timeList={Abs[0.333333 E^(-I t) + 0.333333 E^(I t) + 0.166667 E^(-2 I t) +         0.166667 E^(2 I t)]^2,       Abs[0.\[VeryThinSpace]+ 0.166667 E^(-I t) - 0.166667 E^(I t) +         0.166667 E^(-2 I t) - 0.166667 E^(2 I t)]^2,       Abs[-0.166667 E^(-I t) - 0.166667 E^(I t) + 0.166667 E^(-2 I t) +         0.166667 E^(2 I t)]^2,       Abs[-0.333333 E^(-I t) + 0.333333 E^(I t) + 0.166667 E^(-2 I t) -         0.166667 E^(2 I t)]^2,       Abs[0.\[VeryThinSpace]- 0.166667 E^(-I t) - 0.166667 E^(I t) +         0.166667 E^(-2 I t) + 0.166667 E^(2 I t)]^2,       Abs[0.166667 E^(-I t) - 0.166667 E^(I t) + 0.166667 E^(-2 I t) -             0.166667 E^(2 I t)]^2}          hamiltMol={{0, 1, 0, 0, 0, 1}, {1, 0, 1, 0, 0, 0}, {0, 1, 0, 1, 0, 0}, {0, 0, 1,        0, 1, 0}, {0, 0, 0, 1, 0, 1}, {1, 0, 0, 0, 1, 0}}          ighamiltMol =        Dynamic@AdjacencyGraph[hamiltMol,          VertexLabels -> Placed["Name", Tooltip],          GraphStyle -> "SpringEmbedding",          VertexShapeFunction -> (Disk[#1, timeList[[#2]]] &)];          Animator[Dynamic[t], {0, 19}, .5]     ighamiltMol      Generates this animation (2 pictures shown, notice the resizing): ![Mathematica graphics](http://i.stack.imgur.com/JNRzr.png) ![Mathematica graphics](http://i.stack.imgur.com/HgYxH.png) I would like my disks' radii not to exceed 2/3 of the distance between two vertices, so that the graph needs no resizing. The same method applied to `GraphPlot[]` and `GraphPlot3D[]` also does not work, producing results like those obtained with `AdjacencyGraph[]`. I've tried setting a `DataRange->{}`, but it doesn't work either. `Rescale[]`ing didn't work. (Note that this is not a problem in a `Graphics[]` environment.) I don't know what to try next.


Manipulate code creates error messages when file is opened

When I open the file containing the following code I get a series of error messages. Once I evaluate the cell with the code the error messages disappear. What is Mathematica doing when it opens a file, or how can avoid creating this problem for myself in the future?                econmagic1[ ds_, di_, ss_, si_  ] := (       (* begin equilibrium calculation *)           A = { { 1, - 1 ds }, { 1, - ss } };       CC = Inverse[ A ].{ di, si };            Manipulate[        (* begin grid layout*)        Grid[{               (* begin first row *)          {Show[                 (* begin initial supply curve *)             Plot[ ( 1 / ss ) ( x - si ), {x, 0, Part[ CC, 1] },          PlotStyle -> { Red, Dashed },               PlotLegends -> { "Initial Supply Set"}],                 (* begin initial demand curve *)             Plot[ ( 1 / ds ) x + (  - di / ds) , {x, 0, di },           PlotStyle -> Dashed,  PlotLegends -> { "Initial Demand Set"} ],                 (* begin demand curve *)             Plot[ ( 1 / ds ) ( x - et ) + (  - di / ds) , {x, 0,           di + et},  PlotLegends -> { "Demand Set"} ],                 (* begin supply curve *)             Plot[ ( 1 / ss ) ( x - si ), {x, 0,           Part[ Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{ di + et,              si }, 1 ]}, PlotStyle -> Red,          PlotLegends -> { "Supply Set"}],                 (* begin horizontal for equilibrium *)             Plot[Part[           Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{ di + et, si },           2 ],  {x, 0,           Part[ Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{ di + et,              si }, 1 ]},  PlotStyle -> { Dashed, Thick } ],                 (* begin filling for consumer surplus *)             Plot[{  ( 1 / ds ) ( x - et ) + (  - di / ds),           Part[ Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{ di + et,              si }, 2 ] }, {x, 0,           Part[ Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{ di + et,              si }, 1 ]}, Filling -> 1 -> {2},          FillingStyle -> Directive[ Opacity[ 0.1 ], Blue ] ],                 (* begin filling for producer surplus *)             Plot[{  Part[            Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{ di + et, si },            2 ],  ( 1 / ss ) ( x - si ) }, {x, 0,           Part[ Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{ di + et,              si }, 1 ] }, Filling -> 1 -> {2},          FillingStyle -> Directive[ Opacity[ 0.1 ], Red ] ],                 (* begin equilibrium point *)             ListPlot[{ {            Part[ Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{ di + et,               si }, 1 ],            Part[ Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{ di + et,               si }, 2 ] } }, PlotStyle -> Black,          PlotLegends -> { "Equilibrium Point" }],                 (* begin dashed lines for market equilibrium *)                  Graphics[{ Dashed,           Line[{ {              Part[ Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{ di + et,                 si }, 1 ], 0 }, {              Part[ Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{ di + et,                 si }, 1 ],              Part[ Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{ di + et,                 si }, 2 ]}}] }],                 AxesOrigin -> { 0, 0 },         PlotRange -> { { 0, di + 10 }, { 0, (  - di / ds) + 10 }},           AxesLabel -> { "Quantity", "Price"}, ImageSize -> Large        ]}, (* End Show *)               (* begin second row *)          { Grid[{                  (*          second row first column *)             {"QD Price Intercept:" TraditionalForm[ - ( di + et ) / ds ],                   (* second row second column *)               "QD Quantity Intercept:" TraditionalForm[ di + et ] },                  (*          third row first column *)                 {"QS Price Intercept:" TraditionalForm[ - si / ss ],                   (* third row second column *)               "The equilibrium point is:"     TraditionalForm[ {              Part[ Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{ di + et,                 si }, 1 ],              Part[ Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{ di + et,                 si }, 2 ] } ] },                  (*  fourth row first column *)               {"Consumer Surplus:" TraditionalForm[(               1 / 2 ) ( (- di / ds ) -                Part[ Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{                   di + et, si }, 2 ])  Part[               Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{ di + et,                 si }, 1 ] ],                   (* fourth row second column *)               "Producer Surplus:" If[                     (*  Does the Supply Curve Intersect the Price Axis *)                ( - si / ss ) >= 0,                     (*  Supply Curve Intersects Price Axis *)                 TraditionalForm[ .5 (                Part[ Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{                    di + et, si }, 2 ] - ( - si / ss  ) ) (                Part[ Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{                   di + et, si }, 1 ] )],                     (* Supply Curve Does Not Intersect Price Axis *)            TraditionalForm[ 0.5  ( Part[                  Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{ di + et,                    si }, 1 ] -  si  ) (                Part[ Inverse[{ { 1, - 1 ds }, { 1, - ss } } ].{                   di + et, si }, 2 ] )]                 ] }          },        Alignment -> Left, Frame -> All, Spacings -> { 4, 1 } ]        }        }, Alignment -> Left],        { { et, 0 },  -4.5, 25 } ]        )


How to change coordinates of a differential operator?

I'm doing a basic quantum mechanics problem and am trying to learn how to do it in _Mathematica_. Any help would be much appreciated. $\vec{L} = \vec{x} \times \vec{p}$ where $\vec{x}$ has components: $\begin{align*} x &= r \sin \theta \cos \phi\\\ y &= r \sin \theta \sin \phi\\\ z &= r \cos \theta \end{align*}$ and $\vec{p}$ has components: $p_x = - i \hbar \dfrac{\partial}{\partial x}$ etc. Show that $L_z = -i \hbar \dfrac{\partial}{\partial \phi}$


Efficiently adding a fixed real numbered value to a set of elements in an array

Imagine I'm trying to add some value $r$ to each element in a very large array $L$. Take for example:               L = Table[RandomReal[{0,1}],{q,1,10^7}];     r = 0.0032;      I can effectively add $r$ to each element in $L$ by writing:               L = Table[L[[q]]+r,{q,1,Length[L]}];      This operation takes about $\approx 322$ milliseconds. However, is there a better / faster way to proceed?


#[[1]]//FullForm = 1?

I have a set of symbolic algebraic expressions that I'm trying to get some speed into. To illustrate the issue, I'll use a simple form like `{ k0 X, k1 Y, k1 Z}`, where each term is large and complicated. By random walk, I've arrived at a promising form               { r0 X, r1 Y,r1 Z}/.r0->k0 /.r1->k1      which is faster than the original, but with my particular set of expressions, it turns out that a function is faster:               {#[[1]] X, #[[2]] Y, #[[2]] Z}&@{k0, k1}      The expressions are large, making substitutions by hand time consuming and error prone, so I set out to replace the k s with a rule like               {k0->#[[1]],k1->#[[2]]}      I was surprised that this wasn't a straightforward operation, k0 being replaced by 1 instead of the intended #[[1]]. I thrashed around for a bit, eventually finding the odd (to me) result that               {#[[1]], #[[2]]}//FullForm      Gives               List[ 1, Part[Slot[1],2]]      Can anyone suggest a way of thinking in which this makes sense? Is there any place in the design for `Part[Slot[1],1]` ? I worked around it with a hack:               {#[[2]] X, #[[3]] Y, #[[3]] Z}&@{Null, k0, k1}      which works but is ugly to say nothing of embarrassing. Thanks in advance.


Why is NeighborhoodGraph so slow?

To get neighboring vertices I first tried:               gg = GridGraph[{10, 10, 10, 10}];     VertexList[NeighborhoodGraph[gg, 1, 1]] // AbsoluteTiming        > {5.539308, {1, 2, 11, 101, 1001}} But that is really slow. This is much faster and still uses the new `Graph` package:               Union[VertexInComponent[gg, 1, 1], VertexOutComponent[gg, 1, 1]] // AbsoluteTiming      > {0.000172, {1, 2, 11, 101, 1001}}' I believe that this mimics the `NeigborhoodGraph` approach above, but is still much faster than using `NeighborhoodGraph`:               VertexList[Subgraph[gg, Union[VertexInComponent[gg, 1, 1],            VertexOutComponent[gg, 1, 1]]]] // AbsoluteTiming      > {0.000306, {1, 2, 11, 101, 1001}} The last two approaches are also faster than `NeighborhoodVertices` from the `GraphUtilities` package:               Needs["GraphUtilities`"]     NeighborhoodVertices[gg, 1, 1] // AbsoluteTiming      > {0.017248, {1, 2, 11, 101, 1001}} I'm working with large graphs that I need to manipulate quickly for several interactive information visualization tools. Any tips on why NeighborhoodGraph is so slow here and how to best use the new Graph package when speed is an issue?


How to save a GraphicsRow output?

I need to save the result of GraphicsRow command as a pdf or jpg file. Something like `GraphicsRow[{plt1,plt2,plt3}] -> pdf`. On clicking on the image there is not a "Save Graphics as" option that one finds on a Plot output. In the end, I need to add arrows and annotations to the whole output and save it as a single jpg or pdf file. I can add stuff but I can't get the output saved unless I issue the command `Export["test.pdf", %]`. What am I missing?


Pattern matching repeated structures with named subexpression components

I am trying to write a function with a pattern that tests its arguments for a particular structure. But in that pattern I'd like to name a subpattern to make it easier to exract and operate on. The code below works fine:               Plant[x:Allele[_,_]..] := Involute[{x}]      But what I really want is to extract the parts of each Allele expression and pass them as lists to Involute. I tried using the definition below (expecting `a` and `b` to be Sequences of the arguments to Allele):               Plant[x:Allele[a_,b_]..] := Involute[{x}, {a}, {b}]      Unfortunately, this produces unexpected results when evaluated - specifically it only seems to work on expressions that accept a single Allele argument. When a expand the pattern I get:                In: (x:Allele[a_,b_]..)//FullForm     Out: Pattern[x, Repeated[Allele[Pattern[a, Blank[]], Pattern[b, Blank[]]]]]      which doesn't seem right. Where's the mistake?


Get number of combinations without "forbidden patterns"

I need to get the number of all combinations of binary digits in an 8-digit binary number, but minus some "forbidden" patterns like:               xxxx0xx1     x1xxx0xx     x1xxx0x0      (where x is any digit) These shouldn't be in "valid" combinations I would like to count. My numbers are much larger in fact, so I can't simply enumerate them. What should I do?


Building matrices by attaching vectors (columns) and matrices

Having the need to attach a column to a matrix or to join matrices to make longer rows is an operation that I use very frequently and I find the `Join` function ideal for these cases.               m1 = {{10, 11, 12}, {21, 22, 23}};     m2 = {100, 101};          (* Join matrices to make longer rows: *)     Join[m1, m1, 2]     (* --> {{10, 11, 12, 10, 11, 12}, {21, 22, 23, 21, 22, 23}} *)          (* Attach a column to a matrix *)     Join[m1, List /@ m2, 2]     (* --> {{10, 11, 12, 100}, {21, 22, 23, 101}} *)          (* Join two columns to make a matrix *)     Join[List /@ m2, List /@ m2, 2]     (* --> {{100, 100}, {101, 101}} *)      However, I wanted to define my own function that would simplify the notation needed to reach my goal:               columnAttach[a1_List, a2_List] :=        Join[If[VectorQ[a1], List /@ a1, a1],        If[VectorQ[a2], List /@ a2, a2], 2]          columnAttach[m1, m1]     (* --> {{10, 11, 12, 10, 11, 12}, {21, 22, 23, 21, 22, 23}} *)     columnAttach[m1, m2]     (* --> {{10, 11, 12, 100}, {21, 22, 23, 101}} *)     columnAttach[m2, m2]     (* --> {{100, 100}, {101, 101}} *)      This works as expected, but I would like to generalize it a bit. For instance, `Join` can take a list of vectors/matrices of any length:               Join[m1, m1, List /@ m2, List /@ m2, 2]     (* --> {{10, 11, 12, 10, 11, 12, 100, 100},       {21, 22, 23, 21, 22, 23, 101, 101}} *)      How can I adapt my `columnAttach` function to achieve the same flexibility?


What can I do to improve the performance of my calculations?

I'm trying to express a simple probability problem in _Mathematica_ , but am having trouble getting my calculations to execute at a reasonable speed. I have an object whose unknown location is modeled as a random variable with coordinates $\Theta=(\Theta_1,\Theta_2)$ distributed as $$f_\Theta(\theta)=f_\Theta(\theta_1,\theta_2)=\frac{1}{2\pi}e^{-(\theta_1^2+\theta_2^2)/2}$$ and a collection of sensors at given locations $(a_i, b_i)$ each of which has a probability of detecting a signal from the object that decays exponentially with the distance, modeled as a boolean-valued random variable $X_i$ with $$\mathbf{P}(X_i=T|\Theta=(\theta_1,\theta_2))=p_{X_i|\Theta}(T|\theta)=e^{-\sqrt{(a_i-\theta_1)^2+(b_i-\theta_2)^2}}$$ so that the joint PDF of a set of sensor states $x=\\{x_1,x_2,\ldots\\}$ and object location $\theta$ is $$f_{X,\Theta}(x,\theta)=f_\Theta(\theta)p_{X|\Theta}(x|\theta)=f_\Theta(\theta)\prod_{i|x_i=T}p_{X_i|\Theta}(T|\theta)\prod_{i|x_i=F}(1-p_{X_i|\Theta}(T|\theta))$$ so that $$p_X(x)=\int_{-\infty}^\infty\int_{-\infty}^\infty f_{X,\Theta}(x,\theta)d\theta_1 d\theta_2$$ and thus the probability that the object is at location $(\theta_1,\theta_2)$ given a set of sensor observations $x$ is given by the PDF $$f_{\Theta|X}(\theta|x)=\frac{f_{X,\Theta}(x,\theta)}{p_X(x)}$$ I've tried to express this in _Mathematica_ as               PDetect[sensloc_, srcloc_] := Exp[-EuclideanDistance[sensloc, srcloc]];     PDFSrcloc[srcloc_] := 1/(2 Pi)Exp[-(srcloc[[1]]^2 + srcloc[[2]]^2)/2];                           (*PDF[BinormalDistribution[{1,1},0],srcloc]*)     PDFJointSrcSens[srcloc_, senslocs_, sensstates_] :=        PDFSrcloc[srcloc]*        If[Length[sensstates] > 0,          Times @@ MapThread[           If[#1, PDetect[#2, srcloc],  1 - PDetect[#2, srcloc]] &, {sensstates, senslocs}], 1];     PDFSensLocs[senslocs_, sensstates_] :=        PDFSensLocs[senslocs, sensstates] =         If[Length[sensstates] > 0,          NIntegrate[          PDFJointSrcSens[{x, y}, senslocs, sensstates], {x, -Infinity,            Infinity}, {y, -Infinity, Infinity}], 1];     PDFSrcLocGivenSens[srcloc_, senslocs_, sensstates_] := (PDFJointSrcSens[srcloc, senslocs, sensstates])/        PDFSensLocs[senslocs, sensstates];      This seems to give me the results I expect, but performance is quite slow and plagued with beeps and warnings for many values. This is adequate for simple evaluations and marginal plots, but I need to put this in a `Manipulate` in which I dynamically plot the `DensityPlot` for `PDFSrcLocGivenSens` — that is, $f_{\Theta|X}(\theta|x)$ — as I add and remove sensors (adding/removing and changing the values of $x_i$; adding and removing elements to `senslocs` and adjusting the corresponding `sensstates`). What can I do to speed up my calculations and avoid the beeps I'm getting? * * * I'm (clearly) not great at this, so any assistance in a more elegant formulation would be appreciated. I'm particularly unhappy with my argument and function names. The original formulation of the scenario, which I may have garbled, can be found on p. 418 of _Introduction to Probability, 2nd Edition_, by Dimitri P. Bertsekas and John N. Tsitsiklis.


Creating a nonperiodic function in mathematica

I want to create a non-periodic square wave with values of 1 and -1(not necessarily alternating). For e.g. I want to convert an arbitrary array like {1,-1,-1,1,-1,1,-1} into a function. I tried using Piecewise but I don't know how to do this without typing a huge number of conditions. I also want to add the length of each stack(i.e. the duration for which it is in 1 or -1) e.g. two inputs value={1,-1,-1,1,-1,1,-1} and duration={5,6,1,2,3,8,2} Please Help P.S: The version I am using is 8.0.4.0


Operator operation

There are two basic operators `r={x,y,z}` and `p=-I*h*{D[#,x] , D[#,y], D[#,z]} &`. The angular momentum operator is defined as $\hat{\textbf L}=\hat{\textbf r}\times\hat{\textbf p}$. So how can I get `L` from `p` and `r` in mathematica? The first thing that comes to mind, `l=Cross[r,p]`, won't work. P.S. how could I define `p` in a better, more MMA-styled way?


Avoiding unnecessary computations within loops

Consider the following data:               test = RandomReal[{1, 2}, {10, 5, 3, 3}];      How can I do the following without the `For` loops, e.g. using `Table` or similar _Mathematica_ functions?               Module[{res = {}},        For[i = 1, i < 11, i++,         For[j = 1, j < 6, j++,            p = test[[i, j, 1]];           q = test[[i, j, 2]];           r = Cross[p,q];           mat = Orthogonalize[{p, q, r}];           For[k = 1, k < 6, k++,             AppendTo[res, mat.SeparationVector[p, test[[i, k, 1]], 2]]]]];       res]      where               SeparationVector[x_, y_, z_] := If[# < z/2, x - y, Sequence @@ {}]& @       Sqrt[Total[((x - y) - z*Round[(x - y)/z])^2]]      My Problem with using `Table` is that between the `j` and `k` indices, I define variables that depend on `j` so that I don't have to calculate these values for every iteration of `k`. I don't know how to achieve the same functionality without the `For` loops. But this is _Mathematica_ , and I know there are better and faster ways to do this. Any ideas?


How can I Flatten this List with Inner List of Lists?

Given the following `List`               lis =     {       {1, 2, 3}, {3, 2, 3}, {{3, 7, 5}, {7, 5, 3}, {6, 2, 1}}, {3, 2, 7},        {{3, 3, 5}, {7, 7, 8}, {9, 4, 2}, {9, 0, 0}}, {8, 5, 4}, {7, 4, 3}     }      I would like to get this `List`:               {       {1, 2, 3}, {3, 2, 3}, {3, 7, 5}, {7, 5, 3}, {6, 2, 1}, {3, 2, 7},        {3, 3, 5}, {7, 7, 8}, {9, 4, 2}, {9, 0, 0}, {8, 5, 4}, {7, 4, 3}     }.      `Flatten` is not doing it for me. Note that the actual List is huge and the List of Lists contained in this list can have variable lengths as in the example above one contains 3 inner list the other contains 4.


Polynomial Approximation from Chebyshev coefficients

I would like to expand a function $f(r)$ in the domain $[0,R]$, around the points $r =0$, and $r = R$ in the following manner $f(r = 0) = \Sigma_{i=0,i = even}^{imax} f_i (r/R)^i$ and $f(r = R) = \Sigma_{k=0}^{kmax} f_k (1 - r/R)^k$ I would like to get the coefficients $f_i$ and $f_k$ by first decomposing $f(r)$ into Chebyshev's and then turn that into the power series. Here is what I have so far for a random function : g[x_] = 0.17768*x^5 + 0.115594*x^4 - 0.049490*x^3 - 0.659085*x^2 - 0.2254209; The function looks like ![enter image description here](http://i.stack.imgur.com/XLZC5.jpg) Now to expand $g[x]$ in terms of Chebyshev I do this               In[8]:= GS = 6; (*gridsize*)          In[9]:= Clear[A, a]          In[10]:= A = Array[a, GS + 1, 0]          Out[10]= {a[0], a[1], a[2], a[3], a[4], a[5], a[6]}          In[11]:= For[i = 1, i <= GS + 1, i++, a[i] = 2/\[Pi]*         (Integrate[g[y]*ChebyshevT[i, y] 1/Sqrt[1 - y^2], {y, -1, 1}])]          In[12]:= a[0] = 1/\[Pi]* (Integrate[g[y]*ChebyshevT[0, y] 1/Sqrt[1 - y^2],          {y, -1, 1}])          Out[12]= -0.511616          In[13]:= A          Out[13]= {-0.511616, 0.0739325, -0.271746, 0.0431525, 0.0144492, 0.011105, -1.00221*10^-15}          In[14]:= t1 = Table[a[i]*ChebyshevT[i, y]  , {i, 0, GS}]          Out[14]= {-0.511616, 0.0739325 y, -0.271746 (-1 + 2 y^2), 0.0431525      (-3 y + 4 y^3), 0.0144492 (1 - 8 y^2 + 8 y^4), 0.011105 (5 y - 20 y^3 + 16         y^5), -1.00221*10^-15 (-1 + 18 y^2 - 48 y^4 + 32 y^6)}          In[15]:= g1[y_] = Sum[t1[[i]], {i, 1, GS + 1}]            Out[15]= -0.511616 + 0.0739325 y - 0.271746 (-1 + 2 y^2)      + 0.0431525 (-3 y + 4 y^3) + 0.0144492 (1 - 8 y^2 + 8 y^4)      + 0.011105 (5 y - 20 y^3 + 16 y^5) -1.00221*10^-15 (-1 + 18 y^2 - 48 y^4 +           32 y^6)      Now I plot the function and the Chebyshev approximation $g1[x]$. ![enter image description here](http://i.stack.imgur.com/VkVYQ.jpg) and you can not really see the difference between the two plots, so this makes me think I am doing the Chebyshev part correctly. After this I attempt to get the power series approximation using (Numerical Recipes sectinon 5.10, Clenshaw recurrence)               In[17]:= Clear[D1, d]          In[18]:= D1  = Array[d, GS]          Out[18]= {d[1], d[2], d[3], d[4], d[5], d[6]}          In[19]:= d[GS + 1] = 0          Out[19]= 0          In[20]:= d[GS] = 0          Out[20]= 0          In[23]:= For[i = GS - 1, i >= 1, i--, d[i] = 2*x*d[i + 1] - d[i + 2] + a[i]]          In[24]:= D1          Out[24]= {0.041885 - 2 (0.0144492 + 0.02221 x) x       \+ 2 x (-0.286195 - 0.02221 x + 2 x (0.0320475 + 2 (0.0144492 + 0.02221 x) x)), -0.286195 - 0.02221 x + 2 x (0.0320475 + 2 (0.0144492 + 0.02221 x) x), 0.0320475 + 2 (0.0144492 + 0.02221 x) x, 0.0144492 + 0.02221 x, 0.011105, 0}               In[27]:= d[0] = x*d[1] - d[2] + a[0]          Out[27]= -0.225421 + 0.02221 x - 2 x (0.0320475 + 2 (0.0144492 + 0.02221 x) x) + x (0.041885 - 2 (0.0144492 + 0.02221 x) x + 2 x (-0.286195 - 0.02221 x +       2 x (0.0320475 + 2 (0.0144492 + 0.02221 x) x)))               In[28]:= f[x_] = Simplify[d[0]]          Out[28]= -0.225421 + 5.48173*10^-16 x - 0.659085 x^2 - 0.04949 x^3 + 0.115594 x^4 + 0.17768 x^5      Now I plot all there versions ![enter image description here](http://i.stack.imgur.com/b4mbJ.jpg) and again I can see no difference between different versions. I take this to mean that I have used the Clenshaw recurrence correctly. **Question 1: Did I really use it correctly or did I just get lucky?** **Question 2: How would I change my code to deal with the function $f(r)$ around the origin which has to be normalized in its domain?** **Question 3: Where do I even begin with $f(r)$ around $r =R$ since that does not have the normal power series form?**


Having input aliases appear in the autocomplete box?

On mathematica 9 when you begin to type a special character you get a popup window that allows you to autocomplete it like such: ![](http://i.stack.imgur.com/VBR06.png) However, when you try the same with an input alias like ![enter image description here](http://i.stack.imgur.com/MZAED.png) no autocomplete appears. Is it possible to add the input alias to the autocomplete box and have them appear there like the special characters?


How to make a cleaner copy out of a blurry text image before OCR?

A cleaner copy can be obtained from a blurry original by using the `level adjustment` in _Photoshop_ before going for a better OCR. The picture below shows an example. My code below failed to do so. What is the appropriate way to get the same job done in Mathematica? ![enter image description here](http://i.stack.imgur.com/dAwXm.jpg)                im = Import ["http://i.stack.imgur.com/BO30x.jpg"];      Manipulate[      adjIm = Dilation[Erosion[Sharpen[im, a], b], c],      Grid[{        {         Control[{{a, 0, "Sharpen"}, 0, 10, Appearance -> "Labeled"} ],         Control[{{b, -1, "Erosion"}, -2, 2, Appearance -> "Labeled"}  ],         },        {         Control[{{c, -1, "Dilation"}, -2, 2, Appearance -> "Labeled"} ],         Button["OCR", Print[TextRecognize@adjIm]]         }        }]      ]      ![enter image description here](http://i.stack.imgur.com/JE6o9.jpg)


Plotting a piecewise function with strange subdomains

I have a function, which analityc expression is $C=2*max[b-c,0]$(you can see the expressions of b and c down). Then I have to considerer $q_\pm=\frac{(1\pm \sqrt{ (1-C^2)})}{2}$ and then to plot $E_n=-q_+log_2(q_+)-q_-log_2(q_-)$. I tried in this way:               b = (p*(2 - n)/4);     c = n*(1 + p)*(2 - n)/16 + (1 - p)*(2 - n)/8;     Conc = If[(b - c) < 0, 0, 2*(b - c)];     qplus = (1 + Sqrt[1 - Conc^2])/2;     qminus = (1 - Sqrt[1 - Conc^2])/2;     En = -qplus*Log[2, qplus] - qminus*Log[2, qminus]     Plot3D[En, {n, 0, 2}, {p, 0, 1}]      This is the output: > -(1/(2 Log[ 2]))(1 - √(1 - If[2 (-(1/8) (2 - n) (1 - p) + 1/4 (2 - n) p - > 1/16 (2 - n) n (1 + p)) < 0, 0, 2 (b - c)]^2)) Log[ 1/2 (1 - √(1 - If[2 > (-(1/8) (2 - n) (1 - p) + 1/4 (2 - n) p - 1/16 (2 - n) n (1 + p)) < 0, 0, 2 > (b - c)]^2))] + (1/( 2 Log[2]))(-1 - √(1 - If[2 (-(1/8) (2 - n) (1 - p) + > 1/4 (2 - n) p - 1/16 (2 - n) n (1 + p)) < 0, 0, 2 (b - c)]^2)) Log[ 1/2 (1 + > √(1 - If[2 (-(1/8) (2 - n) (1 - p) + 1/4 (2 - n) p - 1/16 (2 - n) n (1 + p)) > < 0, 0, 2 (b - c)]^2))] > > Indeterminate expression (0 (-∞))/Log[2] encountered. I don't know where is the error. Thank you.


Looking for an elegant way to solve a (system of) ODEs/functional equations with undetermined coefficients

I want to solve an ODE using undetermined coefficients/guess-and-verify and am looking for an elegant way to use this technique. I am running into a few ugly warts. Here is a basic implementation for a simple example:               ode = r v[z] == Exp[z] + g v'[z] + s^2/2 v''[z]     guess = {v[z_] -> a Exp[z] + b Exp[c z]} (* for some a,b,c*)          (* Inelegance 1: how can I substitute the guess into the ode directly?     For example, ode //. guess doesn't work  *)     guessderivs =        Union[guess, {v'[z_] -> (D[v[z] /. guess, z]), v''[z_] -> (D[v[z] /. guess, z, z])}]     (* ugly, but complete now.  Substitute*)          odesub = ode //. guessderivs // FullSimplify     (* => e^z (1 + a (g - r)) + b e^(c z) (c g - r) == 0 *)          (*Inelegance #2: This is an easy example, but is there a standard way to     get equations to solve for all z?  SolveAlways[odesub,z] didn't work *)          (* Doing it manually works, of course*)         a$sub = First@Solve[(2 + a (2 g - 2 r + s^2)) == 0, a]         c$sub = Solve[(2 c g - 2 r + c^2 s^2) == 0,c]          (* The last constant, b, would come from an initial value. mine is v'[0]==0 for example *)      To summarize where this is ugly:   1. How to make a guess substitution of a functional form, and have the derivatives work (i.e. `v'[z] //. {v[z_]-> a Exp[b z]}` but actually substitute the derivatives) I recognize the problem here that `FullForm[v'[z]] == Derivative[1][v][z]` so the rule doesn't match, but is there a nice way to replace these generally?   2. How to get the system of equations (in general) with undetermined coefficients? I thought that `SolveAlways` was supposed to do this? **EDIT:** It looks like the cleanest method is from @RiemannZeta which is to give a list of linearly independent basis vectors (anonymous as described by @belisarius), substitute, and find the coefficients. For this setup, let me give the following goal for some generic UndeterminedCoefficientsSystem function:               ode = {r v[z] == Exp[z] + g v'[z] + s^2/2 v''[z]};     ic = {v'[0] == 0};     equations = Union[ode, ic]; (* In reality, I will be trying a system of equations *)     v$basis = {Exp[#]&, Exp[d #]&, # &}; (* with an addition to test, which should be 0 here *)         coefficientsystem = UndeterminedCoefficientSystem[{{v, v$basis}}, equations};          (* Assume that this function generates a list of coefficients of the form C[1][1], C[1][2],... for the entire basis then it substitutes into the set of equations  *)     coefficientsystem == {C[1][1] == -1 - g C[1][1] + r C[1][1] - 1/2 s^2 C[1][1],     C[1][2] == -d g C[1][2] + r C[1][2] - 1/2 d^2 s^2 C[1][2],     C[1][3] == r C[1][3],     C[1][1] + d C[1][2] + C[1][3] == 0     } (* The last equation comes from the v'[0]==0 *)      So basically, the function does the following:   1. For arguments, takes a list of function name with a list of basis as anonymous functions. Here it is only 1, but I need to use this to solve a more complicated system of ODEs. Index the functions by j.   2. Take each function with index j and basis of length i of anonymous functions. Generate a list of coefficients for `C[i][j]` of these.   3. For each function and basis, create a guess anonymous function as the linear combination of these, with the `C[i][j]` coefficients. Create a substitution rule given the function name to the linear combination of basis.   4. For each given equation, substitute in the concatenated list of guesses (for each j)   5. For each basis, for each equation, find the coefficient with @RiemannZeta technique and append the whole list (if there are different basis for the different functions, it is reasonable to just look for the coefficients of the union of all anoymous basis)   6. Return the whole list of equations. Does that make sense as a generic function? It should work for any sort of functional equations, and not just ODEs. (I am getting stuck very early here. For example, we need to have anonymous guesses (to ensure that we can both take derivatives and evaluate at initial values such as `v'[0] == 0`) but how do I take two anonymous functions and concatenate a linear combination to form a new one?)


Function output of two lists are only diagonal elements

I'm having a little crysis over here. What I basically want to do is some sort of 3D-Plot, but I'm only interested in the resulting values. I have two vectors x and p:               x={x1,x2}; p={p1,p2};      and I want to calculate the value of the function f depending on 2 variables, for example               f[x_,p_]=x*p;      The input               f[x,p]      however does only calculate the diagonal elements and not all terms f[x1,p1], f[x1,p2], f[x2,p1] and f[x2,p2] what I would intuiveley expect from it. I tried some "Map" commands but didn't get the desired result. Could someone please help me out? And if possible even share some insight of why Mathematica is doing only the diagonal elements by default? I would be very interested in it because I have the feeling that my way of thinking is often quite perpendicular to the way Mathematica does -.-


double-backslash-file path problem@version 10.0

I found this happen @ _Mathematica 10_ pre test version and formal English version.   * Copy a file from windows, then paste into FrontEnd cell, you'll get a path, such like `"C:\\Users\\Hyper\\Documents\\b"` This is Ok. However, in the Chinese character case               "C:\\Users\\Hyper\\Documents\\新建文件夹"      This is bad. [It's fine before version 10.0]   * choose a file then Shift+Right-Mouse-Click, and `Copy as path`, then paste into FrontEnd cell, you'll get a path, such like `file1="C:\Users\Hyper\Documents\b"` `file2="C:\Users\Hyper\Documents\新建文件夹"` `file3="C:\Users\Hyper\Documents\b\新建文件夹"` So, two methods to get path from windows system both work badly, ie `FileExistsQ[file1]==>False` `FileExistsQ[file2]==>True` `FileExistsQ[file3]==>False` I have many old files in Chinese path, they cannot be dealt conveniently by _Mathematica 10.0_ @Windows now. I should manually delete a backslash in the path string, and if I use another method to get file path, \b, \hello these names are annoying. ![enter image description here](http://i.stack.imgur.com/7kTqs.jpg) Is this a simple bug? Why not just keep it the same as that in Version 9?


Defining tensor components generally

I would like to define a tensor according to its components, something like the following:               [F(x)]_i,j = Integrate[f(x,y)A_i(y)B_j(y),y]      where i and j are components between 1 and 3, i.e. A_i(y)B_j(y) is a 2nd rank tensor. F is also a 2nd rank tensor, with components i and j. Now, I don't want to explicitly enter the separate values for this definition, i.e.               [F(x)]_1,1 = Integrate[f(x,y)A_1(y)B_1(y),y]     [F(x)]_1,2 = Integrate[f(x,y)A_1(y)B_2(y),y]      etc. How can I do it generally? Also, I would not like to enter specific values for A and B components, but keep it general for arbitrary A and B. * * * ### EDIT Suppose I have the following:               f = 5 x + 3 y;     A = {8 y^2, 5 y, 17 y^3 + 3};     B = {7 y + 3, 4 y, 5 y + 3 y^2};      Now, I don't know my exact input (that's what I am asking) but it would be something like that:               F[i,j]=Integrate[f A[[i]] B[[j]],{y,0,8}]      I want it to be defined as a tensor, so that later I will be able to contract its indices with other tensors. My output should look like:               F = {{Integrate [f*A[[1]] B[[1]], {y, 0, 8}],            Integrate [f*A[[1]] B[[2]], {y, 0, 8}],            Integrate [f*A[[1]] B[[3]], {y, 0, 8}]},          {Integrate [f*A[[2]] B[[1]], {y, 0, 8}],            Integrate [f*A[[2]] B[[2]], {y, 0, 8}],            Integrate [f*A[[2]] B[[3]], {y, 0, 8}]},          {Integrate [f*A[[3]] B[[1]], {y, 0, 8}],            Integrate [f*A[[3]] B[[2]], {y, 0, 8}],            Integrate [f*A[[3]] B[[3]], {y, 0, 8}]}}      I want this to work when I don't define explicitly `A`, `B`, `f`. without definitions, I want _Mathematica_ to write the answer in terms of `A[[1]]` etc, and understand it as a tensor, so I can use it later. I hope now it's clear.


Use EvaluationCompletionAction to notify me only after long evaluation

Is it possible to use the option `EvaluationCompletionAction` to notify me (e.g. with a `Beep[]`) when an evaluation that took longer than, for example, 30s is finished? One of the default settings for EvaluationCompletionAction is `"ShowTiming"` which indicates that the frontend is in some way aware of the duration of evaluations. Ideally, I would want something like this:               SetOptions[       $FrontEnd,       EvaluationCompletionAction -> Which[duration > 30, Beep[]]     ]      Is it possible to do this? And could anyone point me in a direction how to accomplish this?


Using Combinatorica`ListNecklaces in v9

I am using _Mathematica_ for visualization of DeBruijn graphs. However, I am having a bit of trouble using `ListNecklaces`. I want to know how many cyclic shifts of length `n` with variables `x` and `y`. This is equivalent to looking at the number of necklaces (cyclic) with `n` beads and 2 colors. However, I'm not sure how to use the command `ListNecklaces`. I don't get anything back when I input `ListNecklaces[n ,2, Cyclic]`. I also am having trouble with some of the graph theory commands. In versions older than V9, I would need to load the Combinatorica package. Is it true that now I don't have to? Sometimes, _Mathematica_ doesn't recognize `ListNecklaces`, `DeBruijnGraph`, etc. What is the proper way to set up _Mathematica_ to use these? I am using Version 9, Student's Edition.


Mathematica 10 Notebook Fonts Look Bad

I've upgraded my home installation of _Mathematica_ from version 9 to 10 today on a Windows 8.1 machine, and I'm getting a weird font issue - the fonts are not anti-aliased, and look unbalanced and weird. Just look: > ![HALP](http://i.stack.imgur.com/cnuXE.png) For comparison, here what it looks on Linux with _Mathematica_ V10 > ![Mathematica graphics](http://i.stack.imgur.com/Qf6kO.png) At this point you may object, as these issues are too minor to get worked up about. But neither I nor my otherwise benign OCD can work like this. Any ideas? **EDIT** I've just had an idea, that maybe I need to manually remove old fonts leftover from the old _Mathematica_ 9 installation. I've read somewhere that they were not going to pollute the main font catalog with symbol fonts in the next release, and maybe the new _Mathematica_ is using old fonts for some reason. I can't test it right now myself, unfortunately.


Numerical integration of two variable function

The aim is to calculate the definite integral of the function $f$ of the form $$f(x,t) \;\;\;\; x \in [0, \infty ) \;\;, \;\;t \in [t_0,T]$$ numerically. For example consider the function below $$f = e^{-xt}$$ For each **$t_i$** belongs to interval $[t_0, T]$, there is an integral like this: $$\int_{0}^{\infty} f(x, t) dx \;\;\;\;\;\;\;\;\;\;\;\;\;\;\;\;\;\;\;\;\;\;\;\;\;\;\;\;\;\;\;\;(*)$$ If the interval of $[t_0,T]$ divided to $n$ equal part, then we have $n$ integral of the form $(*)$ where $t_i$ is the lower bound of each interval. Also I'm willing to plot the result of $n$ integration. In MATLAB it's easy to code the above integral; by defining a **for** loop, one can deal with sweeping **t** over interval $[t_0,T]$.                         for t = t0 : 0.01 : T                    fun = @(x) f(x, t);                   q = integral(fun,0,Inf);               end      I familiar with the command "Integrate" (in Mathematica) but I can't sweep **t** over interval. How can I do this?


UNIX time to DateList

I have data that is timestamped with UNIX time, which is the number of seconds since January 1, 1970 UTC. Unfortunately, it seems that most of the date and time functions in Mathematica are based on the system's local time zone. How can I convert a UNIX timestamp to a `DateList` in UTC?


How to put some number of queens on chess board dynamically?

I asked how to make resizable chessboard in here. nickjamesuk help me . Here is the code. I thought I can put queens on the board chess board easily after created resizable board, but it didn't work out. Now, I want to write whole problem here. For now, I don't need to solve the N-queens problem. I have some solution, and I want to represent that solutions of N-queens problem attractively. Here is an example: ![Board example](http://i.stack.imgur.com/tj735.png) Also, number of solution is different for each board size. Here is the source. I want to include all the solution for individual board sizes. End product should have two parameters. First one will resize the board from 1 to n. Second parameter will be used changing between different solutions for predefined board sizes. It seems very hard task for me. I will really appreciated everybody try to do it.


What's the difference between variables with and without a subscript?

If I input $x = a + b$, the $x$, $a$ and $b$ are blue. When I hit `Shif`+`Enter`, the $x$ turns black, indicating the kernel now knows this variable. But when I input $x_r = a + b$, and hit `Shift`+`Enter`, $x_r$ is still blue. What's the difference between variables with and without subscript?


Converting an expression to modular arithmetic automatically

I have the expression $\frac{1}{15} \left(-(-1)^n-5\times 2^{n+2}+3\times 2^{2 n+1}+15\right)$ which I want to calculate mod _m_ for a very large _n_. My current method is to ask for this exression in **FullForm** :               Times[Rational[1,15],Plus[15,Times[-1,Power[-1,n]],Times[-5,Power[2,Plus[2,n]]],Times[3,Power[2,Plus[1,Times[2,n]]]]]]      And to conver all `Rational`s and `Power`s to `PowerMod`s manually:               Mod[Times[PowerMod[15,-1,m],Plus[15,Times[-1,PowerMod[-1,n,m]],Times[-5,PowerMod[2,Plus[2,n],m]],Times[3,PowerMod[2,Plus[1,Times[2,n]],m]]]],m]      However, this is kind of time-consuming and I'm sure there's a better way. Is there any sort of 'smart' find-and-replace function I can apply to do something like this?


How should I reproduce this colorful swirling gif?

Surfing on the web, I came upon this cool gif: ![enter image description here](http://s6.pikabu.ru/post_img/2014/05/10/7/1399712484_969112766.gif) Does any one know how to reproduce this in Mathematica? I have some ideas myself, so I will try to answer this question as well.


Reading binary strings from file as strings

I have a file that contains binary strings like               01011     00101     01011      I want to import the file to Mathematica as a list of strings, but               Import["test.dat", "Table"]      gave me               {{1011}, {101}, {1011}},      which is a list of numbers rather than strings. What should I do to make sure that the binary strings are read as strings rather than numbers?


How would I get the best quality plot into a TeX editor which includes the legends?

I have currently used "Save Selection As" after highlighting the graph and legend and then saved it as a PNG file, but the quality isn't brilliant. I am using TeXworks on Windows 7. The "Copy As LaTeX" gives an error message as well, guess it doesn't like the legends. Saving it as a PDF or EPS file messes up the title in the plot, which are some recommendations I saw on different questions.


Multiplying a list and randomly re-assigning that list to a series of numbers

I'm trying to write a script that matches a particular element to a coordinate. Let's say there are 24 coordinates; and that fractionally a:b:c:d:e is 18%:18%:18%:18%:27%. Instead of matching 4 of a, b, c, and d to individual coordinates and e to the final 8 (to a sum of 24), I want to generate a list of 24 points from my initial list of a,b,c,d,e and those percentages and then randomly pair them to available coordinates. The current code I'm using is below, is there an easier way to do this? Inputs:               elements = Transpose[{{aa, bb, cc, dd, ee}}]     xelement = {0.09, 0.09, 0.09, 0.09, 0.18};     spin = Transpose[{{"Spin=4", "Spin=3", "Spin=3", "Spin=2",       "Spin=2"}}];          PosFCC = {     {0.000000, 0.250000, 0.500000 },      {0.166667, 0.750000, 0.000000 },      {0.333333, 0.750000, 0.500000 },      {0.666667, 0.750000, 0.500000 },      {0.833333, 0.500000, 0.500000 },      {0.833333, 0.250000, 0.000000 },      {0.333333, 0.500000, 0.000000 },      {0.500000, 0.750000, 0.000000 },      {0.833333, 0.750000, 0.000000 },      {0.000000, 0.000000, 0.000000 },      {0.000000, 0.500000, 0.000000 },      {0.333333, 0.000000, 0.000000 },      {0.000000, 0.750000, 0.500000 },      {0.500000, 0.000000, 0.500000 },      {0.166667, 0.000000, 0.500000 },      {0.166667, 0.250000, 0.000000 },      {0.666667, 0.500000, 0.000000 },      {0.500000, 0.500000, 0.500000 },      {0.666667, 0.250000, 0.500000 },      {0.166667, 0.500000, 0.500000 },      {0.333333, 0.250000, 0.500000 },      {0.666667, 0.000000, 0.000000 },      {0.500000, 0.250000, 0.000000 },      {0.833333, 0.000000, 0.500000}      };      Current Code:               pos1 = ArrayFlatten[{{elements, spin}}];     For[       (i = 1) && (balance = 0) && (store = pos1),       i < Dimensions[pos1][[1]] + 1,       i++,       (For[          j = 1,          j < (If[             balance > 1.01,             ((Round[xelement[[i]]*Dimensions[PosFCC][[1]]]) + 1),             (Round[xelement[[i]]*Dimensions[PosFCC][[1]]])             ]),          j++,          store = Insert[store, pos1[[i]], 1]          ])        &&        (If[          balance > 1.01,          balance = 0,           balance =            balance + (xelement[[i]]*Dimensions[PosFCC][[1]] -               Round[xelement[[i]]*Dimensions[PosFCC][[1]]])          ]         )       ];          pos2 = RandomSample[store];     pos3 = Transpose[Insert[Transpose[PosFCC], pos2[[All, 1]], 1]];     pos4 = Transpose[Insert[Transpose[pos3], pos2[[All, 2]], 5]];     posd = TableForm[pos4, TableSpacing -> {0, 5}];      Output:               bb     0.           0.25     0.5     Spin=3     dd     0.166667     0.75     0.      Spin=2     dd     0.333333     0.75     0.5     Spin=2     bb     0.666667     0.75     0.5     Spin=3     cc     0.833333     0.5      0.5     Spin=3     ee     0.833333     0.25     0.      Spin=2     aa     0.333333     0.5      0.      Spin=4     dd     0.5          0.75     0.      Spin=2     ee     0.833333     0.75     0.      Spin=2     bb     0.           0.       0.      Spin=3     aa     0.           0.5      0.      Spin=4     ee     0.333333     0.       0.      Spin=2     ee     0.           0.75     0.5     Spin=2     aa     0.5          0.       0.5     Spin=4     bb     0.166667     0.       0.5     Spin=3     bb     0.166667     0.25     0.      Spin=3     aa     0.666667     0.5      0.      Spin=4     cc     0.5          0.5      0.5     Spin=3     aa     0.666667     0.25     0.5     Spin=4     dd     0.166667     0.5      0.5     Spin=2     dd     0.333333     0.25     0.5     Spin=2     cc     0.666667     0.       0.      Spin=3     cc     0.5          0.25     0.      Spin=3     cc     0.833333     0.       0.5     Spin=3