I have several contour lines and one point. How can I find a point in one of those contour lines which is nearest to the given point? (*Create the implicit curves*) Data={{10,20,1},{10,40,2},{10,60,3},{10,80,4},{20,25,2},{20,45,3},{20,65,4},{30,30,3},{30,50,4},{40,35,4},{40,55,5},{50,20,4},{50,40,5},{60,25,5}}; U=NonlinearModelFit[Data,a x^b (y^(1-b))+c,{a,b,c},{x,y}]; L={ContourPlot[U[x,y]=={1},{x,0,100},{y,0,100},ContourStyle->Red],ContourPlot[U[x,y]=={2},{x,0,100},{y,0,100},ContourStyle->Magenta],ContourPlot[U[x,y]=={3},{x,0,100},{y,0,100},ContourStyle->Brown],ContourPlot[U[x,y]=={4},{x,0,100},{y,0,100},ContourStyle->Blue],ContourPlot[U[x,y]=={5},{x,0,100},{y,0,100},ContourStyle->Green]}; (*Point nearest to which we need to find the points on the curves*) pt={30,50}; (*Graphic*) Show[L,Graphics[{PointSize[Large],Blue,Point[pt]}],FrameLabel->{"X","Y"}]

Bug introduced in 10.0.0 and fixed in 10.1.0. Has anyone had problems with the DeleteMissing function in Mathematica 10.0.2? I find that it rarely works. Most of the time it returns a list which still contains all of the missing elements. For example, let's say a = {Missing[], 1, 2, 3} then DeleteMissing[a] returns {Missing[] , 1, 2, 3} . Answer I can reproduce this problem only if the Suggestions Bar is enabled. In this case DeleteMissing seems to mysteriously lose its definition. In[1]:= {$Version, $VersionNumber, $ReleaseNumber} Out[1]= {"10.0 for Mac OS X x86 (64-bit) (December 4, 2014)", 10., 2} In[2]:= a = {Missing[], 1, 2, 3} Out[2]= {Missing[], 1, 2, 3} In[3]:= DeleteMissing[a] Out[3]= DeleteMissing[{Missing[], 1, 2, 3}] In[4]:= Definition@DeleteMissing Out[4]= Definition[DeleteMissing] This looks to be the exact same issue from here: Please report it to Wolfram Support . As a workaround, you can turn off the Suggestions Bar by going to Preferences -> In...

I'm trying to create a 3d histogram/ matrix plot pair. My data is in the form {{TTR1,TBF1},{TTR2,TBF2},....} What I would like is to modify the Histogram3D so instead of having the counts of each bin on the z axis I would have the sum of TTR in that bin. I would also like the modify the matrix plot in the same way. I've hacked an example in the help to get this far; hist := Histogram3D[Log[10, dateFilter[[All, 2]]], {-4, 4, 0.25}, Function[{xbins, ybins, counts}, Sow[counts]], AxesLabel -> {Style["TTR (log(hours))", 16], Style["TBF (log(hours))", 16]}, ImageSize -> Large, PlotLabel -> Style["Dryer 1 TBF and TTR Counts", 18], ChartStyle -> RGBColor[27/255, 121/255, 169/255], ViewPoint -> {Pi, Pi, 2}]; {g, {binCounts}} = Reap[hist]; mPlot := MatrixPlot[First@binCounts, ImageSize -> Large] Row[{g, mPlot}] In this case my data list is dateFilter[[All, 2]]={{TTR1,TBF1},{TTR2,TBF2}....} I would also like to fix this axis on the MatrixPl...

I would like to draw a graph with Mathematica in such a way that it looks like a handmade drawing or painting. To be more precise, is there a way to set a custom edge style such that it looks made with writing ink or with a brush stroke? If this is not possible in Mathematica , are you aware of any software that can be used to obtain such an effect? If so, what is the best format in which to export my graph? Answer You ought to use EdgeRenderingFunction to achieve this. First, import a graphic for a brushstroke: BRUSH = Import[NotebookDirectory[] "brush.png"] Then use the EdgeRenderingFunction option in GraphPlot to obtain the image. GraphPlot[Graph[{1 -> 2, 2 -> 3, 3 -> 1}], EdgeRenderingFunction -> ({Inset[BRUSH, Mean[#1], Automatic, 1.7, #[[2]] - #[[1]]]} &), VertexRenderingFunction -> None ] The value 1.7 was something I tweaked based on my image. I recommend using a well-cropped image with a transparent background. I used the image: to obtain...

I need a faster implementation of FractionOfYear and FractionOfMonth , which do the following: Input: A time/date specified by {y_, m_, d_, h_, n_, s_} Output: A real number from 0 to 1 representing the fraction of the year or month that the given time/date spec occurs in. Leap days and leap seconds complicate things, so I thought I could just rely on DateDifference , but it is too slow: RandomDateList[] := {RandomInteger[{1800, 2100}], RandomInteger[{1, 12}], RandomInteger[{1, 28}], RandomInteger[{0, 23}], RandomInteger[{0, 59}], RandomInteger[{0, 59}]}; RandomDates[n_] := Table[RandomDateList[],{n}] secondOfYear[{y_, m_, d_, h_, n_, s_}] := First[DateDifference[{y - 1, 12, 31, 24, 0, 0}, {y, m, d, h, n, s}, "Second"]] / First[DateDifference[{y - 1, 12, 31, 24, 0, 0}, {y, 12, 31, 24, 0, 0}, "Second"]] secondOfMonth[{y_, m_, d_, h_, n_, s_}] := First[DateDifference[{y, m, 1, 0, 0, 0}, {y, m, d, h, n, s}, "Second"]]/First[DateDifference...

Given that the documentation for FindMinimum uses ReplaceAll for its various examples of what to do with the found solution to an optimization problem, it would seem to be the right tool for the job. However, the following MWE highlights the speed problem I ran into using ReplaceAll for such a situation. Is using Block the appropriate tool in this case and why? vars = Table[f[i], {i, 1, 10000}]; vals = RandomReal[1, Length[vars]]; soln = MapThread[#1 -> #2 &, {vars, vals}]; Total[vars] /. soln // Timing (*{1.395787, 4980.51}*) Block[{f}, ReleaseHold[ MapThread[Hold[#1 = #2] &, Transpose[List @@ # & /@ soln]]]; Total[vars]] // Timing (*{0.033995, 4980.51}*) A slight variation on the Block approach, which I expect would be equivalent, is also slightly slower (here both have been repeated 1000 times to show the less-significant difference of ~20%). Is there another approach that would achieve the same but faster? Do[Block[{f}, ReleaseHold[ MapThread[Hold[#1...

I'm wanting to plot the solid of revolution from the area between two functions such as: $1\leq x \leq e$ and $1 \leq y \leq 2 + ln(x)$, doing something like this: f[x_]:=2+Log[x] g[x_]:=1 RevolutionPlot3D[{{f[x]}, {g[x]}}, {x, 1, E}, RevolutionAxis -> x, AxesOrigin -> {0, 0, 0}, Boxed -> False, Mesh -> {5, 0}, PlotRange -> {{0, 3}, All}, PlotStyle -> Opacity[0.5]] Is there a way to fill this empty space between $f(x)$ and $g(x)$? Answer This one doesn't need V10: RegionPlot3D[ 1 Mesh -> None, AspectRatio -> 1, PlotRange -> {{0, 4}, {-4, 4}, {-4, 4}}]

For example, Collect[(1 + x + Cos[s] x^2)^3, x] gives the result 1 + 3 x + 3 x^5 Cos[s]^2 + x^6 Cos[s]^3 + x^2 (3 + 3 Cos[s]) + x^3 (1 + 6 Cos[s]) + x^4 (3 Cos[s] + 3 Cos[s]^2) Terms of the form $x^n$ are in random order. I would like the result is to be as follows: 1 + 3 x + x^2 (3 + 3 Cos[s]) + x^3 (1 + 6 Cos[s]) + x^4 (3 Cos[s] + 3 Cos[s]^2) + 3 x^5 Cos[s]^2 + x^6 Cos[s]^3 Well, First Thank you very much, Jens! Second, I found there is something wrong with your statement "the HoldForm could be left out". I have tried on my mathematica 8, it turns out that the "HoldForm" is necessary . if "HoldForm" is not there, the order is still random in the output . And I tried to understand this as well as "rule" and "ruledelayed" stuff but can't figure it out. I have tried several input, each confused me. summarized as follows Replace[cx, List[x__] -> Plus[x]] will give Sequence[1, 3 x, x^2 (3 + 3 Cos[s]), x^3 (1 + 6 Cos[s]), x...

It is known that space curves can either be defined parametrically, $$\begin{align*}x&=f(t)\\y&=g(t)\\z&=h(t)\end{align*}$$ or as the intersection of two surfaces, $$\begin{align*}F(x,y,z)&=0\\G(x,y,z)&=0\end{align*}$$ Curves represented parametrically can of course be plotted in Mathematica using ParametricPlot3D[] . Though implicitly-defined plane curves can be plotted with ContourPlot[] , and implicitly-defined surfaces can be plotted with ContourPlot3D[] , no facilities exist for plotting space curves like the intersection of the torus $(x^2+y^2+z^2+8)^2=36(x^2+y^2)$ and the cylinder $y^2+(z-2)^2=4$: Sometimes, one might be lucky and manage to find a parametrization for the intersection of two algebraic surfaces, but these situations are few and far between, especially if the two surfaces are of sufficiently high degree. The situation is worse if at least one of the surfaces is transcendental. How might one write a routine that plots space curves defined as the...

As suggested by the title, is it possible to fix some part of the neural network while training? Since Mathematica provides a way to extract part of a neural network and combine it with some layers to make a new one: newNet = NetChain[{Take[oldNet, 3], 10, Ramp, 10}] It would be very helpful to fix the layers taken from the old network. In this way one can reuse the neural network and investigate how transferrable are features in the neural network (c.f. https://arxiv.org/abs/1411.1792 ). Answer The LearningRateMultipliers supports using different learning rates with different layers. When setting the learning rate of a particular layer to None, the weight of that layer will be fixed during training. You can have a look at the example in the documentation of LearningRateMultipliers . In that example, net is constructed from part of the network trained for MNIST net = NetChain[Join[Drop[Normal[lenet], -2], {LinearLayer[], SoftmaxLayer[]}], "Input" -> enc, "Out...

When applying some arithmetic operation on two lists, I'd like to display the actual operations between the elements of each list. For example, {1, 1} + {1, -1} would display {1 + 1, 1 - 1} . With simple operations, I could just use Trace and pick out the part with the right form: Trace[{1, 1} + {1, -1}, {_Plus, _Plus}] (* {{1+1,1-1}} *) However, this becomes really cumbersome in more complex operations. Even worse, some operations don't even show element-by-element operations within Trace . Trace[{{1, 2}, {3, 4}}.{{5, 6}, {7, 8}}] (* {{{1,2},{3,4}}.{{5,6},{7,8}},{{19,22},{43,50}}} *) This is what I actually want to display: Of course I could programmatically display the element operation of the matrix multiplication above, but I have to do the same for every other matrix operations. My question is: Is there a straightforward way to display operations on elements of two lists? Please feel free to add your own examples and make it as general as you want to.

In Mathematica 8. Given this: f[x_, y_, z_] := z - x^2 - y^2 (*relation among the variable f[x,y,z]==0*) parameter = Range[0.1, 1, 0.1];(*choice of parameter values*) I'm trying to plot the level curves ContourPlot[Evaluate@Table[f[x, y, z] == 0, {z, parameter}], {x, -1, 1}, {y, -1,1}, PlotLegends -> parameter] I have the next error message: ContourPlot::optx: "Unknown option PlotLegends in ContourPlot[{0.1 -x^2-y^2==0,0.2 -x^2-y^2==0,0.3 -x^2-y^2==0,0.4 -x^2-y^2==0,0.5 -x^2-y^2==0,0.6 -x^2-y^2==0,0.7 -x^2-y^2==0,0.8 -x^2-y^2==0,0.9 -x^2-y^2==0,1. -x^2-y^2==0},{x,-1,1},{y,-1,1},PlotLegends->parameter]" I tried using: Needs["PlotLegends`"] ShowLegend[ ContourPlot[Evaluate@Table[f[x, y, z] == 0, {z, parameter}], {x, -1, 1}, {y, -1,1}, PlotLegends -> parameter] ] what I should do?

Consider this code: MemoryInUse[] T = Table[RandomComplex[], {i, 1, 6000}, {j, 1, 6000}]; MemoryInUse[] T += T\[ConjugateTranspose]; MemoryInUse[] {Es, Ys} = Eigensystem[T]; MemoryInUse[] T = Table[RandomComplex[], {i, 1, 6000}, {j, 1, 6000}]; MemoryInUse[] T += T\[ConjugateTranspose]; MemoryInUse[] {Es, Ys} = Eigensystem[T]; MemoryInUse[] $HistoryLength = 0; MemoryInUse[] Clear[T] MemoryInUse[] Clear[Es, Ys] MemoryInUse[] ClearSystemCache[] MemoryInUse[] It gives me the following results: 15808208 880820520 1456822832 4919500424 5783503032 6359505096 9822181440 9822182648 9822182112 9822181384 9822162952 Clearly, the memory clears negligibly on any of ClearSystemCache , Clear and zeroing $HistoryLength . Repeating its execution leads to swapping, after start of which I hurry up to kill MathKernel before my X or WM or anything else are OOM-killed. So what are the working ways to release the memory? Answer $HistoryLength is just a global variable. It not clear the history. You can s...

I have a function that's represented as a long list of values that I want to integrate. I can do it procedurally with Simpson's rule. ListConvolve generally runs faster then procedural code, so i would like to use it if I can find the right kernel. My list can be of even or odd length, and for the latter I would like to use a method that is better than the trapezoid method. Is there a higher order method for this case?

When thinking on this recent question the immediately obvious solution which came to my mind was to use ReadList with options RecordLists -> True and NullRecords -> True for reading objects of type Number . But I discovered that NullRecords -> True is ignored for Number although RecordLists -> True is respected: ReadList[StringToStream["1 2 3\n4 5\n\n6 7\n8 9"], Number, RecordLists -> True, NullRecords -> True] {{1, 2, 3}, {4, 5}, {6, 7}, {8, 9}} Currently the option NullRecords -> True is respected only for types Record and String : ReadList[StringToStream["1 2 3\n4 5\n\n6 7\n8 9"], String, RecordLists -> True, NullRecords -> True] {{"1 2 3"}, {"4 5"}, {""}, {"6 7"}, {"8 9"}} ReadList[StringToStream["1 2 3\n4 5\n\n6 7\n8 9"], Record, RecordLists -> True, NullRecords -> True] {{"1 2 3"}, {"4 5"}, {""}, {"6 7"}, {"8 9...

Suppose I got in a Dialog and wanted to not Return but Abort the computation. How could I do that? Using Return[] the computation continues, and sometimes that implies getting inside countless other Dialog s of which it is not easy to go out without killing the kernel. How do you handle those situations? Answer I use ExitDialog@Unevaluated@Abort[] If your dialog is unhappily inside a CheckAbort you can go for exceptions like ExitDialog@Unevaluated@Throw["OOOUT", Unique[]] for example. In this way, tools like TraceDialog become very useful. TraceDialog[code, Message] is something I use often, to see the Stack , the state, etc Note that this only aborts one level. If you want 2 levels you could do ExitDialog@Unevaluated@ExitDialog@Unevaluated@Abort[] For a general way to abort all dialogs of any level at once, one could do Apply[Composition, ConstantArray[Function[i, ExitDialog@Unevaluated@i, HoldFirst], DialogLevel[]]][Unevaluated@Abort[]]

I am using pattern matching to identify elements in a list to be replaced. How can I supply a list of patterns to match and replace all elements in the list that match the pattern? The problem I have now is that each replacement generates a new list. But what I want is a single list with all pattern matched elements replaced. Thus far I have tried, x={k1p->0.214161,km1->35.8125,k2p->0.3880,km2->39.57}/. PatternSequence[#->_]->#>0.0&/@{k1p,k2p} (*{{k1p->0.,km1->35.8125,k2p->0.388,km2->39.57},{k1p->0.214161,km1->35.8125,k2p->0.388,km2->0.}}*) And I've tried to use replace repeated (//.) Which does give a single list, however nothing is replaced. x={k1p->0.214161,km1->35.8125,k2p->0.3880,km2->39.57}//.PatternSequence[#->_]->#->0.0&/@{{k1p,km2}} (*{{k1p->0.214161,km1->35.8125,k2p->0.388,km2->39.57}}*) Answer expr = {k1p -> 0.214161, km1 -> 35.8125, k2p -> 0.3880, km2 -> 39.57}; expr /. P...

I would like a table with rational indexes - thus it would be practical to use a dictionary, which, in Mathematica are implemented with the indexed variables. I would like to be able to do: ... If[a[1/2] is defined, a[1/2] = a[1/2] + 1, a[1/2] = 1] ... If[a[4568/8746] is defined, a[4568/8746] = a[4568/8746] + 1, a[4568/8746] = 1] ... and then further along: ConvertToList[a] -> {... {1/2, 4}, {4568/8746, 9}, ... } Had my indexes been integers, I could have used the built-in function Array . But they are not, thus at some point, I need to get a list of all the indexes for which a has a value. I could hack a solution (for instance: implement my own dictionary structure, or keeping a set of all values I defined and use it to know where I should look), but this seems silly. Especially since Mathematica provides the functionality I desire as a meta-function: ?a Unfortunately I can't seem to make use of it programmatically. How can I do what I want? Am I wrong to think that indexed var...

The good old GIF animation format allows us to set the duration of each individual frame in the animation separately. This is especially useful if some frames in the animation sequence are to remain static for an extended period of time, because such delays don't increase the file size of the GIF . Here is an example: frames = Table[ Graphics[ Text[Style["Slow Down", FontFamily -> "Futura", FontColor -> Blue, FontSize -> 48], {0, y}], Background -> Cyan, PlotRange -> {{-1, 1}, {.1, 1.5}}], {y, 1.2, .2, -.1}]; Export["slowDownMovie.gif", frames, "DisplayDurations" -> Append[Range[Length[frames] - 1]/20, 2], "AnimationRepetitions" -> Infinity] Even though the last frames are very long in duration, that has no effect on the file size. Of course one thing GIF doesn't have is a playback control, which allows you to pause and rewind a movie. To combine these two features, it would be nice if...

I have a stream of data like this: 0001100111100000111111001110000001111111111000000111000111110000... (I can represent them as a list, like in {0,0,0,1,1,...}, I guess that's easier to work with.) Now I want to count how many sequences of two "1"s, three "1"s, etc there are (the zeros lengths are not important, they're just separators), to show them in a histogram. I have no problems doing this procedural, but functional programming remains difficult for me. While I don't mind pausing for a cup of coffee (there's 4.8 million data points), I guess in functional programming this will be orders of magnitude faster. How do I do this with functional programming? Note "0011100" only counts as a sequence of length 3, the two sub-sequences of length 2 should not be taken into account. Answer If your data is in list form (conversion from string will swamp advantage), this should be quite a bit faster (5-50+X than existing answers, timings on the...

This is a further question of this post . Actually this code from SqRoots .And this code has completed the task. (I assume you are using Mozilla Firefox and MMA version 11.0) Needs["DatabaseLink`"]; conn=OpenSQLConnection[JDBC["SQLite",First[FileNames["cookies.sqlite",ParentDirectory[$UserBaseDirectory] "\\Mozilla\\Firefox\\Profiles\\",Infinity]]]]; c=SQLExecute[conn,"select * from moz_cookies where baseDomain like '%.stackexchange.com'"]; cookie= #[[-3]],"Name"->#[[2]],"Content"->#[[3]],"Path"->#[[-2]],"ExpirationDate"->#[[-1]]|>&/@c[[;;,{2,4,5,6,7,8}]]; t=URLRead["https://mathematica.stackexchange.com/users/21532/yode?tab=favorites","Body",VerifySecurityCertificates->True,{Cookies->cookie},CharacterEncoding->"UTF-8"]; file=ExpandFileName[Export["testt.txt",t]]; Quiet[DeleteFile[StringReplace[file, "txt" -> ...

What is the most painless way to sum over n variables, for example, if the range of summation is $i_1 Is there a package for this and more complex summation ranges? I am not happy with programming loops all the time for this common summation range and if one has a large summation range, one cannot just use a combinat command to generate all subsets of a certain size, if this takes too much memory. Example: $$f(n)=\sum_{0 Answer You can write a few helper functions to help you. The following can probably be streamlined... vars[s_String, n_Integer?Positive] := Table[Symbol[s ToString[i]], {i, 1, n}] vars[sym_Symbol, num_] := vars[SymbolName[sym], num] nestedRange[vars_List, min_, max_] /; min Transpose@{vars, ConstantArray[min, Length[vars]], Append[Rest@vars, max]} nestedSum[f_, vars:{__Symbol}, min_, max_] /; min With[{r = Sequence @@ Reverse@nestedRange[vars, min, max]}, Sum[f, r]] nestedSum[f_, {var:(_String|_Symbol), num_Integer?Positive}, min_, max_] /; min Then, for example ...

I wonder about how I could make a Graph scale automatically when I vary the size of the vertices. I would like to visualize information with a Graph . The vertices all have e.g. additional info like a weight which I would like to visualize with the vertices drawn with different sizes. However, when I define the sizes, the graph keeps the original (as opposed to the new) layout. The graph then becomes invisible. Graph[{1 \[UndirectedEdge] 2, 2 \[UndirectedEdge] 3,3 \[UndirectedEdge] 1, 3 \[UndirectedEdge] 4}] shows: Now I add the "weight" Graph[{1 \[UndirectedEdge] 2, 2 \[UndirectedEdge] 3,3 \[UndirectedEdge] 1, 3 \[UndirectedEdge] 4},VertexSize -> {1 -> 1.1, 2 -> 1.2, 3 -> 1.3, 4 -> 1.4}] This shows: What I would like is that the Graph would be like Any thoughts? This is a graph currently working on. As you can see one vertex hits his neighbour. I would expect MM to or reposition this vertex a bit further or to scale down all nodes. Of course this can be done ...

I am trying to determine all the variables used in list. For This I use: DeleteDuplicates[Cases[l1,_Symbol,-1]] This is great except that \Pi etc. are symbols too. I want to add Except to this Cases command to discard numeric symbols but I'm not sure where to add it. I tried different combinations, but I either get errors, or it will interpret it differently to what I intended. Alternatively, is there a better way of achieving this? Answer As an example, let us consider the following expression: expr= Log[ 3 Sin[x] + 2 Exp[Pi+ 4 a b + 1/7]]; This is not a polynomial, so the function Variables cannot be used. On level -1 we have the atoms: Cases[expr,_, {-1}] (* {2,E,1/7,4,a,b,\[Pi],3,x} *) Observe that 1/7 is an atom! We restrict ourselves to symbols: Cases[expr,_Symbol, {-1}] (* {E,a,b,\[Pi],x} *) This is not restrictive enough; we only want the symbols that do not have a value. Using Kuba's advice to use function composition: Cases[ expr, _Symbol?(Not @* NumericQ), {-1}...

I have a list that has no definitive pattern or incremental difference. Can I make a Slider go over the items in the list? For instance, here is an arbitrary list of six elements, can a Slider go from list[[1]] to list[[2]] , etc.? list = {0, 1, 2.22, 5, 141, 299}; Answer You can achieve this by using both Dynamic and Slider : {Slider[Dynamic[x], {list}], Dynamic[x]}

I am wondering if it is possible, and how if so, to express function continuity in the assumptions for the definite form of Integrate . First of all, while Integrate[g'[x], x] yields g[x] , Integrate[g'[x], {x, a, b}] does not result in g[b] - g[a] , since this may not hold if g'[x] has discontinuities in the interval. Is it possible to add an assumption about the continuity of g'[x] everywhere in $\mathbb{R}$ so that this integral computes as g[b] - g[a] ? I tried multiple expressions, but MMA keeps returning the expression unevaluated. This does not work: ClearAll[g, x, a, b]; Assuming[{ {x, a, b} \[Element] Reals, ForAll[x, {g[x], g'[x], g''[x]} \[Element] Reals], ForAll[x, -\[Infinity] -\[Infinity] -\[Infinity] }, Integrate[g'[x], {x, a, b}] == (g[b] - g[a]) // FullSimplify ] The last ForAll seems even weaker that the first, but I tried it alone, and both together, and threw in a boundedness condition for the g[x] ...

I want to log messages that I send to the screen, even temporary ones. By setting $Output appropriately, it is possible to log Print messages, but not PrintTemporary messages: oldout = $Output; logfile = FileNameJoin[{$TemporaryDirectory, "example.log"}]; log = OpenWrite[logfile]; $Output = Append[oldout, log]; Print["Log message printed on screen."]; PrintTemporary["Log message printed temporarily on screen."]; Pause[1]; $Output = oldout; Close[log]; Print["Contents of file:"]; FilePrint[logfile]; gives Log message printed on screen. (Log message printed temporarily on screen.) Contents of file: "Log message printed on screen." Perhaps this is not surprising, but if you start Mathematica in non-gui mode (i.e., "MathKernel" on MacOsX), the PrintTemporary output stays permanently on the screen. How can one direct the output of PrintTemporary permanently to an additional output stream? Answer Since PrintTempor...

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

There seems to weird bug regarding non-integer PlotRange in ArrayPlot . For example... ArrayPlot[ Table[Sin[x/50 π] Tanh[y/50 π], {y, 100}, {x, 100}], DataRange -> {{0, 1}, {0, 1}}, PlotRange -> {{0, 1}, {0.5, .9}} ] gives an error: Value of option PlotRange -> {{0,1},{0.5,0.9}} is not All, Full, Automatic, a positive machine number, or an appropriate list of range specifications. The same code works, if one of the plot range parameters for y-axes is turned into an integer. Did I do smth wrong? Is there a workaround? I need to use array plot as ListContourPlot is too slow for large datasets and MatrixPlot has the same problem. I am using Mathematica 8 64 bit version on linux. Edit After some more testing I see, that it works whenever PlotRange includes at least one integer. For example PlotRange -> {{0, 1}, {0.5, 1.2}} works as it includes 1. So one possible workaround is just to scale the range, such that max-min would be larger than 1. But I am still looking...

One of the key steps in merge sort is the merging step. Given two sorted lists sorted1={2,6,10,13,16,17,19}; sorted2={1,3,4,5,7,8,9,11,12,14,15,18,20}; of integers, we want to produce a new list as follows: Start with an empty list acc . Compare the first elements of sorted1 and sorted2 . Append the smaller one to acc . Remove the element used in step 2 from either sorted1 or sorted2 . If neither sorted1 nor sorted2 is empty, go to step 2. Otherwise append the remaining list to acc and output the value of acc . Applying this process to sorted1 and sorted2 , we get acc={1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20} Added in response to Rojo's question: We can carry out this procedure even if the two lists are not pre-sorted. So list1 and list2 below are not assumed to be sorted. If there were a built-in function MergeList which carries out this process, it would probably take three arguments list1 , list2 , and f . Here f is a Boolean function of ...

I would like to count the negative values of a list. My approach was Count[data, -_] which doesn't work. How can I tell Mathematica to count all numbers with a negative sign? Answer I assume that you have numeric values. A much more efficient way would be -Total[UnitStep[data] - 1]] or Total[1-UnitStep[data]] Note: While the second notation is certainly a bit more compact, it is about 35% slower than the double-minus notation. I have no idea why. On my system, it takes on average 0.22 sec vs 0.30 sec. Compare timings between the faster UnitStep version and the pattern matching approach: data = RandomReal[{-10, 10}, 10^7]; Timing[-Total[UnitStep[data] - 1]] (* ==> {0.222, 5001715} *) Timing[Count[data, _?Negative]] (* ==> {6.734, 5001715} *)

Is there a built-in function to do binary search? Say, given a list (sorted) and a number, find the position which keeps the listed sorted when the number is inserted. I know that LengthWhile could manage that, but it's slow. Answer There is some built-in binary search code but not in the core language as far as I know. There is BinarySearch from the Combinatorica package, which is still the function I use most often despite the fact that that package is now deprecated and loading it causes shadowing of some Symbols. There is the undocumented GeometricFunctions`BinarySearch but this function does not appear to perform particularly well. When I need greater performance I typically use a compiled form of Leonid's code from:

I have a function (x^2-9)^2. I can plot it with x-range{-3,3} so that three extremum s can appear in the plot. I add another axis y ranging{0,10}. I want to plot the previous function (x^2-9)^2 at y=0,4,8. Obviously the last two will be the replica of the first one. Just have a look in the image for a rough idea..

A Taylor series is produced with the following code: Series[Sin[x], {x, 0, 15}] x-x^3/6+x^5/120-x^7/5040+x^9/362880-x^11/39916800+x^13/6227020800-x^15/1307674368000+O(x^16) Is there a simple way to prevent the factorial in each denominator from being evaluated? That is, I want an answer of the form: $$\sin(x)=x-\frac{x^3}{3!}+\frac{x^5}{5!}+\cdots$$ Answer s = Series[Sin[x], {x, 0, 15}] // Normal ; s /. Times[_[a_, b_], c_] :>a (c/Inactive[Factorial][InverseFunction[Gamma][b] - 1]) Note: The above method will not work for any function This works for any function: s /. Times[a_, Power[_, b_]] :> (a x^b) (b!)/Inactive[Factorial][b]

A probability distribution can be created in Mathematica (I am using 8.0.1) with e.g. distribution1 = ProbabilityDistribution[(Sqrt[2])/Pi*(1/((1+x^4))), {x,-Infinity,Infinity}]; Random variates from this distribution can be created with RandomVariate easily: dataDistribution1=RandomVariate[distribution1,10^3]; Histogram[dataDistribution1](*Just an optical control*) How can I create random variates from a 2-dimensional (multivariate) probability distribution? Let's say my 2-dimensional distribution is of the following form (very similar to the previous one): distribution2=ProbabilityDistribution[((((Sqrt[2] π^(3/2) Gamma[5/4])/ (Gamma[3/4]))^(-1)))/((1+x^4+y^4)),{x,-Infinity,Infinity}, {y,-Infinity,Infinity}]; I thought it would be logical to try dataDistribution2=RandomVariate[distribution2,10^3]; But that does not work. I get the following message then: RandomVariate::noimp: Sampling from ProbabilityDistribution[Gamma[3/4]…}] is not implemented. I tried a lot of variations of t...

After answering this question , I decided to change it a bit (had some free time), and turned it into a Gross-Pitaevskii equation. Suddenly, the code that used to work now gives the error message: CoefficientArrays::poly: "1/2 (-ψ$6110-ψ$6111)+ψ (1- 1/Sqrt[1+x$6089^2+y$6090^2]+0.1 Abs[ψ]^2) is not a polynomial. I tried changing the potential for the Harmonic Oscillator, but still no use. My code: ClearAll["Global`*"]; g = 0.1; X = 5; V[x_, y_] := 1/2 (x^2 + y^2); ini[x_, y_] := Exp[-(x^2 + y^2)]; bc = ψ[x, y] == ini[x, y] /. {{x -> X}, {x -> -X}, {y -> X}, {y -> -X}}; sys = {-1/ 2 (D[ψ[x, y], {x, 2}] + D[ψ[x, y], {y, 2}]) + (V[x, y] + g Abs[ψ[x, y]^2]) ψ[x, y] == Etr ψ[x, y], bc}; sol = ParametricNDSolveValue[ sys, ψ, {x, -X, X}, {y, -X, X}, {Etr}]; Plot3D[Abs[sol[1][x, y]], {x, -X, X}, {y, -X, X}, PlotRange -> All] If I set g=0 , I get some good results. Any other value and I get the error message. Can anyone explain what'...

Is there an implementation of the resistance distance matrix (or just resistance matrix) for graphs available in Mathematica ? Answer Based on the definition from the Wikipedia article, this should give you the resistance distance matrix of the graph g : With[{Γ = PseudoInverse[KirchhoffMatrix[g]]}, Outer[Plus, Diagonal[Γ], Diagonal[Γ]] - Γ - Transpose[Γ] ]

(see the bottom of this question for the MWE) I'm working with a set of numerical data: numerous (a few thousands) files in the style of list of vectors (quadruplets x, y, vx, vy). Files are named as v1.txt, v2.txt, ..., vk.txt, where k is a few thousands. I am using For loop in Mathematica, in each cycle several steps are performed: 1) load vi.txt 2) make list of pairs of pairs from it (in the form of {{x1, y1},{v1x, v1y}, ...}) 3) construct absolute value of the vector field ({{x1, y1}, norm of {v1x, v1y}, ...}) 4) Make list density plot of the absolute value list 5) Make list stream plot of the pairs of pairs 6) export both. The problem is that after about 200 cycles, Mathematica sucks up all the physical memory available in my machine and the kernel crashes. I tried using: 1) $HistoryLength = 0 2) ClearSystemCache[] after every cycle 3) ClearAll[(plots, data)] after every cycle 4) all of the above combined up to no avail. What am I doing wrong? What should I do to tell Mathemat...