Skip to main content

Posts

Showing posts from January, 2016

graphics3d - How can I fill an entire Building with transparent points?

I am posting the same code found at an earlier question , although the concept here is totally different. The following code corresponds to a building-shaped structure. w = 100; l = 200; h = 30; m = 70; backwall = {{0, l, 0}, {w, l, 0}, {w, l, h}, {0, l, h}}; side1 = {{0, 0, 0}, {0, 0, h}, {0, l, h}, {0, l, 0}}; side2 = {{w, 0, 0}, {w, 0, h}, {w, l, h}, {w, l, 0}}; floor = {{0, 0, 0}, {w, 0, 0}, {w, l, 0}, {0, l, 0}}; top = {{0, 0, h}, {w, 0, h}, {w, l, h}, {0, l, h}}; front = {{0, 0, 0}, {w, 0, 0}, {w, 0, h}, {0, 0, h}}; leftRoof = {{0, 0, h}, {w/2, 0, m}, {w/2, l, m}, {0, l, h}}; rightRoof = {{w, 0, h}, {w/2, 0, m}, {w/2, l, m}, {w, l, h}}; roofBack = {{w, l, h}, {w/2, l, m}, {0, l, h}}; roofFront = {{w, 0, h}, {w/2, 0, m}, {0, 0, h}}; building = {backwall, side1, side2, floor, front, leftRoof, rightRoof,roofBack, roofFront}; figure =Graphics3D[{Opacity[0.5],Style[Polygon[building,VertexColors -> Map[0.5 + #[[3]]/80 &, building, {2}]],Lighting -> {{"Ambient", Whit

plotting - Method -> {"AxesInFront" -> False} for Graphics3D

I'm aware of two ways to manage positioning of Axes for Graphics3D : AxesOrigin and AxesEdge . They seem to be quite different in terms of what is actually happening: GraphicsRow[{ Graphics3D[##, AxesOrigin -> {0, 0, 0}], Graphics3D[##, AxesEdge -> {{-1, -1}, {-1, -1}, {-1, -1}}] } &[Sphere[{1, 1, 1}, 1], Axes -> True, ViewPoint -> {5, 7, 3}]] I want the graphics elements to be up front . For axes being a part of the box it is natural to use AxesEdge since it gives me that effect. However sometimes I want the axes origin to be inside the box. AxesEdge is useless and AxesOrigin creates strange effect: Graphics3D[{Opacity@1, Sphere[{1, 1, 1}, 1]}, Axes -> True, AxesOrigin -> {1, 1, 1}] Axes created with AxesOrigin seem to be different object than with AxesEdge . It looks like some kind of 2D projection in front of 3D graphics while AxesEdge creates something which is part of 3D graphics . As one may know there ( ..fi

differential equations - Elegant way of obtaining the envelope of oscillating function

I am solving a differential equation numerically and the output is an oscillating function with the amplitude of the oscillation decaying in time. I would like to extract the power law governing this amplitude. Let's make this concrete. Let's say I am solving the system x''[t] + 2t^(-1) x'[t] + t^(-2) x[t] == 0 which has solutions x= C[1] t^(-1/2) Cos[Sqrt[3]/2 Log[t]] and the corresponding $\sin$. I would like to extract the power law $t^{-1/2}$. Of course, my system is much more complicated and I have to solve it numerically. I get as my solution an interpolating function. I was thinking of generating a table of function values, sorting according to the maxima and then fitting a power law, but maybe there is a better way? Thanks!

list manipulation - Bigrams and TF-IDF calculation

I want to create a bag of bigrams in a set of documents and calculate the TF-IDF vector of each document. To calculate the bigram of the text I used the following code: The small example of the data (each element in the list is a different document) data = {"The food at snack is a selection of popular Greek dishes. The appetizer tray is good as is the Greek salad. We were underwhelmed with the main courses. There are 4-5 tables here so it's sometimes hard to get seated.","This little place in Soho is wonderful. I had a lamb sandwich and a glass of wine. The price shocked me for how small the serving was, but then again, this is Soho. The staff can be a little snotty and rude, but the food is great, just don't expect world-class service.", "ordered lunch for 15 from Snack last Friday. On time, nothing missing and the food was great. I have added it to the regular company lunch list, as everyone enjoyed their meal."} The way that I create the big

compile - Why is my compiled function slower than a regular function?

I have the following functions: Block[{n, diag}, snake`diag[n_] = Ceiling[1/2 (-1 + Sqrt[1 + 8 n])]; snake`alongdiag[n_, diag_] = {0, diag + 1} + (n - diag (diag - 1)/2) {1, -1}; snake[n_] = snake`alongdiag[n, snake`diag[n]];] (*A003986 on OEIS, http://oeis.org/A003986*) A003986[n_] := BitOr @@ (snake[n] - {1, 1}) A003986c = Compile[{{n, _Integer}}, A003986[n], CompilationTarget -> "C", RuntimeAttributes -> {Listable}, RuntimeOptions -> "Speed"] The functions seem very "compilable" in that they're just numerical computations. However, the compiled function performs as badly or worse: Table[{x, A003986 /@ Range@(10^x); // Timing // First, A003986c[Range@(10^x)]; // Timing // First}, {x, 5}]~ Prepend~{"Func", "ME", "Comp"} // TableForm Fine - perhaps the function does "too little" and the overhead from running the C code is costing too much. But then altering my code to fix that doesn't he

calculus and analysis - Length of a curve parallel to a spline

I have constructed a BSplineFunction through a set of random points: p = Table[{20 Cos[2 π t], 20 Sin[2 π t]} + RandomReal[{-15, 15}, 2], {t, 0, 0.9, 0.1}] f = BSplineFunction[p, SplineClosed -> True]; {{15.7336, -3.557}, {11.1177, -2.53343}, {15.4259, 19.1467}, {6.60292, 10.5131}, {-28.5053, 10.9099}, {-22.7909, -1.35239}, {-3.22756, -13.0483}, {-17.1309, -32.426}, {6.23965, -7.05847}, {25.0532, -25.0634}} I then drew the spline and 3 curves parallel to it: Show[ParametricPlot[Table[f[x] + {{0, 1}, {-1, 0}}.Normalize[f'[x]] * i, {i, 0, 3}], {x, 0, 1}]] I next wanted to find the length of these curves, but the following command can only find the length of the spline, not the adjacent curves. It gives an error for the other curves. Table[NIntegrate[Norm[D[f[x] + {{0, 1}, {-1, 0}}.Normalize[f'[x]]*i, x]], {x, 0, 1}], {i, 0, 3}] {148.521,(*Unevaluated Expression*), (*Unevaluated Expression*),(*Unevaluated Expression*)} At

matrix - How get eigenvectors without phase jump?

I'm using Eigenvectors to get the eigenvectors for some matrixes, but the eigenvectors seems to have some phase jump. Here is an example: Say we have a 2 by 2 matrix {{2., Exp[I x]}, {Exp[-I x], 2.}} and x is a number. Now if we change x smoothly in some region, we would expect the eigenvector or eigenvalues changes smoothly. But in fact, we see that there are jumps. eigenVects = Table[Eigenvectors[{{2., Exp[I x]}, {Exp[-I x], 2.}}][[1]] /. {a_, b_} -> {a/Sqrt[a^2 + b^2], b/Sqrt[a^2 + b^2]}, {x, π/2 + π/10, 3 π/2 - π/10, π/20}] We then take the first eigenvector and plot it's real and imaginary part Row[{ListPlot[Re@Transpose[eigenVects], Joined -> True, ImageSize -> 300, Mesh -> All], ListPlot[Im@Transpose[eigenVects], Joined -> True, ImageSize -> 300, Mesh -> All]}] and we see the curves are not smooth but with some jumps in them. These jumps corresponding to a phase factor to the eigenvectors from the Eigenvectors function. Normally, an eige

plotting - Determining the RGB values of the default plot color

In Mathematica 7, the default plot color is a purple-like color (although I think it is not Purple ). Is it possible to use Mathematica to determine the RGB color values of the default plot color? Thanks for your time. Answer All the default colors can be found in ColorData[1] . To obtain the RGB value of the first color you just need to type: ColorData[1, 1] (* RGBColor[0.2472, 0.24, 0.6] *) To check all subsequent colors just change the n in ColorData[1, n] . To obtain the values on the scale 0 to 255: Round[Rescale[Table[ColorData[1, 1][[i]], {i, 3}], {0, 1}, {0, 255}]] (* {63, 61, 153} *)

front end - Opening new notebooks with a non-default window size

I'd like to set Mathematica (8.0.4.0) up so it opens new notebooks with the "NaturalColor" stylesheet and with a WindowSize like {800,770} . I tried to change default stylesheet via: OptionInspector -> Global Preferences -> Global Options\File Locations\Default Style Definition and I get this ugly notebook instead of this one . And when I Change the value of "WindowSize" from "Medium" to "{800,770}" under "Notebook Options\Window Properties" , it just does nothing. This is driving me crazy, any ideas ?

Accesing keys based on position in an association

I would like to have the following simple function GetKey[] on a very large association. (* The actual Association is very large, this is just small example *) assoc = <|{1,1} -> 2, {1,2} -> 3, {2,1}->4, {2,2}->5|>; GetKey[assoc, 1] GetKey[assoc, 4] (* output *) {1,1} {2,2} That is, I want to access keys based on their position in the association. Any way this can be done efficiently for a large association? I know one can use the Keys[assoc][[position]] function but this is too slow for a large association. EDIT: Based on the comments below I am giving you the timing information for the function I know that does the job. a = 1024*1024; keys = Table[i, {i, a}]; values = RandomReal[{0, 1000000}, {a}]; assoc = Association[MapThread[Rule, {keys, values}]]; AbsoluteTiming[k = Keys[assoc][[10000]];] (* output *) {0.548738, Null} This is too slow for say a hundred thousand accesses. Answer Perhaps: GetKey[assoc_, index_] := First @ Keys @ Take[assoc, {index}] Your firs

performance tuning - Making table of matrix product and efficiency

I want to make a table in which each element is a matrix product: << Developer` n = 2; m = 6; matrix = Map[ToPackedArray[#] &, Table[Sin[1.0*i*j], {i, 1, m}, {j, 1, n}, {k, 1, n}]]; vector = {IdentityMatrix[n][[1]]}\[Transpose]; Do[Flatten[Table[ #1\[ConjugateTranspose].(matrix[[#2]].#1) &[vector, i], {i, 1, m}]], {ite, 1, 2*10^5}] // AbsoluteTiming (*{7.430010, Null}*) In the code above there are two important parts: First part = Choosing one matrix from the lists of matrices matrix and multiply it by vector . Second part = Multiplying vector\[ConjugateTranspose] by the result of the first part. I thought if I convert matrix[[#2]].#1 , the first part, into one matrix multiplication, it would be more efficient as instead of many multiplications I calculate all of them in one go: matrix2 = ToPackedArray[Flatten[Table[matrix[[i]]\[Transpose], {i, 1, m}], 1]]; matrix2 is the desired matrix to do the next step. If you use matrix//MatrixForm , then both the matrices look li

front end - Questions about InlineCell vs InlineFormula vs DisplayFormula cells

I'm having trouble with typesetting, and can't get these questions straight in my head. What is the difference between "InlineCell" and "InlineFormula" style? Is one a subset of the other? In what situations should I use each? And why is InlineCell important enough to have default shortcut ( Ctrl + 9 ) but InlineFormula is not? Does "InlineFormula" have anything to do with an "DisplayFormula" cell? Answer I don't have much experience with writting books or articles in Mathematica so let me just add technicall notes. For use cases I'd search around using those styles as keywords: 4 Ctrl + 9 starts an Inline cell which is not the same thing as an "InlineCell" . But one step at a time. So an Inline cell is special as it is a cell inside a cell (notice that you can't just create it between cells with Crtl + 9 ). And now an "InlineCell" is a style that is used for that area automatically after it is

calculus and analysis - Teaching Mathematica more about DiracDelta and KroneckerDelta

As the documentation and some experimentation indicates, Mathematica contains little information about representations of the DiracDelta and KroneckerDelta functions. Some examples which are not recognized in Mathematica include the identities: Limit[a/(x^2 + a^2), a -> 0] = DiracDelta[x] Integrate[Exp[I k x], {x, -∞, ∞}, Assumptions -> k ∈ Reals] Sum[Exp[I k n], {n, -∞, ∞}] = KroneckerDelta[k] Integrate[h[n, x] h[m, x], {x, -∞, ∞}] = KroneckerDelta[n, m] Sum[h[n, x] h[n, y], {n, 0, ∞}] = DiracDelta[x - y] Where the set of functions h[n, x] is orthonormal. I want to implement these kinds of relations in Mathematica . What would be the programmatic way to do this?

list manipulation - Multidimensional MATLAB conversion

I try to convert this MATLAB code: From: (useful to compute some prox of some functions): case 3 %% 3D field %% V = cat(4, ... U.M{1}(1:end-1,:,:) + U.M{1}(2:end,:,:), ... U.M{2}(:,1:end-1,:) + U.M{2}(:,2:end,:), ... U.M{3}(:,:,1:end-1) + U.M{3}(:,:,2:end)); case 4 %% 4D field %% V = cat(5, ... U.M{1}(1:end-1,:,:,:) + U.M{1}(2:end,:,:,:), ... U.M{2}(:,1:end-1,:,:) + U.M{2}(:,2:end,:,:), ... U.M{3}(:,:,1:end-1,:) + U.M{3}(:,:,2:end,:),... U.M{4}(:,:,:,1:end-1) + U.M{4}(:,:,:,2:end)); "The dimension of U.M{1} is (N+1,N) while that of U.M{2} is (N,N+1) for 2D field". I would like to have the same behavior on Mathematica, without a switch case, on arbitrary dimension. I try to do some mix with Take, Drop, ... Without any success. rank = 4; size = 30; baseDim = ConstantArray[size, rank]; U = Table[Array[Subscript[m, ##] &, ReplacePar

cudalink - Mathematica 12, supported GPUs

It seems that Mathematica 12 doesn't support NVidia 2xxx (i.e 2080), 16xx or 1xxx series. Could it be that the CUDA section has not yet been rewritten for 12? https://reference.wolfram.com/language/CUDALink/tutorial/Reference.html#522022378 Answer To download the most updated version, even if you’ve just updated & are having trouble: Needs["CUDALink`"] CUDAResourcesInstall[" ", Update->True] As noted by @ilian, version 12 supports Turing chips/architecture. What this means is that GPUs with these chips will be supported. Turing chips are in all RTX cards. You only gain more and more access to computing resources as you go from 2060->2080. 2080->2080 Ti brings you a "true" Turing chip, with the RTX Titan having a "fully unlocked" Turing chip. All of these use Cuda 10, which is what is supported by Version 12 of Wolfram Language and Mathematica. I will not discuss the Nvidia GPU Turing Architectures further, as that is outside o

hardware - Mathematica connection to Arduino *Micro*...any idea how to set DTR high?

According to my experience and to various information, such as http://forum.arduino.cc/index.php?topic=310096.0 https://stackoverflow.com/questions/21887615/can-not-view-serial-data-on-arduino-micro ...the Arduino Micro board will not write data to the host unless "DTR is set to high". I have been successfully interfacing Mathematica with Arduinos (such as Mega), but am stuck with the Micro, because of the above issue. Does anyone know how to set the DTR to "high" on the Mathematica side? Are there any options to given in DeviceOpen when opening the port, to set the DTR to high? Many thanks for any hint. Ioan

scoping - Module does not remove a function definition

The following is a minor variant of the function uniqueTuples as given by Simon Woods in this answer . g[lists___List] := Module[{f}, f[___, x_, x_,___] := Sequence[]; f[x___] := (f[x]=Sequence[];{x}); Attributes[f]={Orderless}; Flatten[Outer[f, lists], Length[{lists}]-1]] data=RandomInteger[40, {6,11}]; Length[g @@ data] // Timing (* {6.177640,388897} *) In the definition of g we have a local variable f, which is used as a function and for which a lot of DownValues could be created. This function is not removed when the Module is evaluated: Names["f$*"] (* {f$,f$342} *) Length[DownValues[f$342]] (* 388899 *) I am using version 10.0.2 on Windows (32-bit). Indeed, this bug made Mathematica crash due to lack of memory when I used this function a number of times with larger arguments. Answer g[lists___List] := Module[{f}, f[___, x_, x_, ___] := Sequence[]; f[x___] := (f[x] = Sequence[]; {x}); Attributes[f] = {Orderless, Temporary}; Flatten[Outer[f, lists], Length

calculus and analysis - How can I avoid a scoping problem when differentiating?

I simplify my real problem as follows: I define a rule function as Clear[rule]; rule[i_] := tt -> i; the real rule function is not this simple. I define a matrix function as Clear[hh]; hh[x_, y_, i_] := {{tt, x}, {y, 1}}/. rule[i]; I want to define a function hhpar that will differentiate hh with respect to x , so I write Clear[hhpar]; hhpar[x_, y_, i_] := D[hh[x, y, i], x]; This doesn't work and I know why. But I still can't figure out a way to write a proper hhpar . How would I do that?

functional style - Map vs. Table for index-specific operations on 2D arrays–Part II

This is an extension of my recent question, Map vs. Table for index-specific operations on 2D arrays For that question I gave a minimal working example, since I was more interested in learning generally about a functional approach to index-specific operations on 2D arrays than in solving my specific problem. The answers I received were very helpful in enabling me to see how a functional approach could be more syntactically straightforward than my usual tool for such problems ( Table ). But when I tried to apply that functional approach to my actual problem (which I have solved with Table ), I ran into trouble. Here is some sample data. Each row starts with an employer number, and is followed by 11 fields of data for each employee of that employer. This contains data for two employers, nos. 125 and 126; no. 125 has two employees, and no. 126 has three. t = {{125.`, "Employee Number(See line above)", " 1", " Date of Birth", " 11/24/1969", "

evaluation - What are the cool kids talking about when they use ##&[]?

All the cool kids are apparently using ##&[] for Unevaluated @ Sequence[] but I have no idea what either means. Please explain what these things are so I can be a cool kid! Answer Try this: Map[If[#==1,Unevaluated@Sequence[],#]&,{1,2,3}] Note the output. The 1 is gone. That's because Unevaluated@Sequence[] puts the empty sequence there, that is, "nothing". ##&[] is a shorthand that can be used in most places for same - ## is the sequence of arguments, & makes it a function to apply to something, [] is that something - an empty argument list, so the result is... a sequence that is empty.

differential equations - Trouble with ParametricNDSolveValue

I have this: eqns = { x1'[t] == -10 x1[t] + 10 x2[t], x2'[t] == a1 x1[t] - x2[t] - x1[t]*x3[t], x3'[t] == -(8/3) x3[t] + x1[t] x2[t] }; ics = {x1[0] == a, x2[0] == b, x3[0] == c}; Then this: pfun = ParametricNDSolveValue[{eqns, ics}, {x1, x2, x3}, {t, 0, 10}, {a1, a, b, c}] But when I try to plot: Plot[pfun[50, 1, 1, 1][t], {t, 0, 10}] I get a blank image. What am I doing incorrectly? Due to Helpful Answers: Thanks for the responses. Turns out the easiest answer for me is to replace the output {x1, x2, x3} with {x1[t], x2[t], x3[t]}. pfun = ParametricNDSolveValue[{eqns, ics}, {x1[t], x2[t], x3[t]}, {t, 0, 10}, {a1, a, b, c}]; Plot[Evaluate[pfun[50, 1, 1, 1]], {t, 0, 10}] Which produces this image: You can see why this works by entering: pfun[50, 1, 1, 1] Which produces this output: {InterpolatingFunction[{{0., 10.}}, <>][t], InterpolatingFunction[{{0., 10.}}, <>][t], InterpolatingFunction[{{0., 10.}}, <>][t]} I can also grab the first so

graphics - How to draw block diagrams as Graph objects?

In the documentation ClosedLoopResponsesWithAPIDController , There is a very nice block diagram. I want to create my own block diagrams similar to this. I clicked on the diagram and pressed "command-shift-E" to show the underlying expression. I found the expression below. While this is explicit and reasonably easy to modify and extend, For really big graphs (which I have) it will rapidly become too difficult to manage by hand. I wonder if there is an easier way to produce such graphics? Is there a tool I just don't know about for drawing and / or automatically laying out such things? Graph[{1, 2, 3, 4, 5, 6, 7, 8, 9}, {{{1, 2}, {2, 3}, {3, 4}, {4, 5}, {5, 6}, {6, 7}, {6, 2}, {8, 4}, {9, 6}}, Null}, { EdgeLabels -> {DirectedEdge[8, 4] -> Placed[ Style["+", {FontFamily -> "Helvetica", GrayLevel[0, 1], 12}], {1, {-0.8, 0.2}}], DirectedEdge[3, 4] -> Placed[ Style[&qu

Correct way to handle mysterious NaN` result from MathLink function

I have a Mathematica expression that is mapped onto an external C function via MathLink . The external function passes a double array (using MLPutReal64List[] ), which Mathematica interprets as a list of Real 's. Sometimes the external function sends values for which the C math library function isnan(value) returns 1 (say from division by zero, or log(0) ). Mathematica reads these values as NaN` . For example, In[1]:= result = externalFunction[ ] Out[1]= {NaN`, 0.18225} Evaluating {NaN`, 0.182255} gives a syntax error: In[2]:= {NaN`, 0.182255} Syntax::tsntxi: "{NaN`,0.182255}" is incomplete; more input is needed. Syntax::sntxi: Incomplete expression; more input is needed. which makes sense, since a variable name is expected to follow the ` , giving some variable in the NaN context. But mathematica accepts result[[1]] as a number: In[3]:= NumericQ[result[[1]]] Out[3]= True In[4]:= NumberQ[result[[1]]] Out[4]:= True !! Yet I haven't been able to find a pattern th

list manipulation - Finding time-series direction reversal of certain magnitude

I'd like to find the points of a time-series that are a certain distance away (in value, not in time) from the previous maximum, which I consider a reversal. For example, for {1, 2, 3, 5, 10, 8, 6, 3} with a threshold of 4 , the reversal point would be 6 , since it's 4 units away from the previous maximum of 10 . I want to find all such reversal points, but at each one I need to reset the running maximum (or split the list and start again on the new list). Here is some code to find the first reversal. It computes the distance from each element to a rolling maximum, then looks for the first difference bigger than the threshold. ts = {1, 2, 3, 5, 10, 8, 6, 3}; rollmax = FoldList[Max, First[ts], Rest[ts]]; delta = rollmax - ts; sel = Map[# >= 4 &, delta]; index = Position[sel, True, 1, 1] I can do this in a procedural way, but it's probably not the preferred way. I'm new to functional programming and I don't quite know what sort of patterns are available that

functions - "do ... while" loop equivalent in Mathematica

Have I missed something or is there no built-in which mimics the behaviour of do ... while loop ? I am looking for a construct that evaluates procedure once and then repeatedly evaluates it while test is not fulfilled. I'm ended up using: While[procedure; test, {}] But clearly the second argument is redundant, so I have a feeling that I'm missing something. Maybe not, but I just want to be sure :) Answer While While[procedure; test] works, it looks very similar to While[test, procedure] . The only difference is ; vs , . While is not the most commonly used construct, so when used like this there's a high chance of misunderstanding/misreading. If readability/reliability is a concern (for example a collaboratively developed published package), I'd use the longer but clearer While[True, procedure; If[Not[test], Break[]] ] The only argument here is readability and "defensive programming" (extra effort to avoid accidental problems). Readability is subj

How to include 2 dimensional disks in a Graphics3D object (Ellipsoid)

I hope I am not doing something wrong. Compare the following figures. 1) Ellipsoid Graphics3D[{{Specularity[White, 40], Opacity[0.5], Ellipsoid[{0, 0, 0}, {10, 3, 2}]}, {Opacity[1], Ellipsoid[{0, 0, 0}, {0, 3, 2}], Ellipsoid[{0, 0, 0}, {10, 0, 2}], Ellipsoid[{0, 0, 0}, {10, 3, 0}]}}, ImageSize -> Large] 2) The same goal but in a more "user-defined" way Graphics3D[{Specularity[White, 40], Opacity[0.5], Scale[#, {10, 3, 2}], {Opacity[1], Scale[#, {.001, 3, 2}], Scale[#, {10, 0.001, 2}], Scale[#, {10, 3, 0.001}]}} &@Sphere[], ImageSize -> Large] Why the quality of the first Graphics3D is so bad? $Version (*"10.3.0 for Linux x86 (64-bit) (October 9, 2015)"*) Answer The problem with the first graphic is that you are trying to create a 3D object with exactly zero width in one dimension. In the second graphic, you make the width in that dimension equal to a small value. This same workaround can be applied to the Ellipsoid call,

plotting - ListContourPlot has wrong colouring: workaround?

Bug introduced in 8 or earlier and persisting through 11.0.1 or later ListContourPlot uses the wrong colouring here: res = Import["https://dl.dropboxusercontent.com/u/38623/res.wdx", "WDX"]; ListContourPlot[res, Contours -> Range[0.66, 0.9, 0.02], ColorFunction -> "Rainbow"] The contour plot shows that the function value decreases around the bottom middle, even though it reaches its maximum there in reality. The tooltips for the contour values between the red and orange regions are correct however: one contour shows 0.84 and the other 0.86. It's just the colouring that's wrong. Compare ListDensityPlot[res, ColorFunction -> "Rainbow"] What is the simplest, most convenient workaround for this problem? Also, is this a bug or am I missing something? Can anyone explain why this happens? I do need these specific contour values. Interpolation + ContourPlot gives the exact same result: if = Interpolation[res] ContourPlot[if[x, y], {x,

dynamic - Clickable clock making sound

I have a moving clock Dynamic[Refresh[ClockGauge[], UpdateInterval -> 1]] which should be clickable. Program should make a sound when hand of a clock will touch the point where I clicked before. I found something like this: EventHandler[ Framed@"Play", {"MouseClicked" :> EmitSound[Sound@SoundNote["C", 10*^10, "Flute"]], "MouseExited" :> EmitSound[Sound@SoundNote[SoundVolume -> 0]]}] to make a sound on click. But I don't know how to get the position of clicked point. Answer Here is a quick first draft: DynamicModule[{s = 0, pt = {0, 1}}, Column@{ClickPane[ Dynamic[Show[Refresh[Graphics[ClockGauge[]], UpdateInterval -> 1], Graphics[{Red, Point[pt]}]]], (pt = #; s = 30*(1 + ArcTan[-pt[[2]], -pt[[1]]]/Pi)) &], DynamicWrapper[Dynamic@s, If[DateValue["Second"] == Round[s], EmitSound[Sound@SoundNote["C", 0.5, "Flute"]]], UpdateInterval -> 1]}] I'll

latex - How to automate x[i]→x_{i}?

I have several Mathematica expressions in which subscripts are expressed with square brackets. E.g. x[12] is meant to represent x 12 , etc. If I evaluate TeXForm on such an expression, x[12] , e.g., gets converted to x(12) . Is there a way to get it to produce the x_{12} form instead? Answer Probably the easiest solution here is to use Format[x[arg_],TraditionalForm]:=Subscript[x, arg] This makes sure that the subscript form is used when the display is in TraditionalForm , which is also an intermediate step in creating TeXForm . Then you get for example 1+x[13]//TeXForm $x_{13}+1$ The Format can't be specified directly for TeXForm because then expressions where your x[12] is surrounded by other things as in 1 + x[12] won't get translated correctly.

differential equations - Piecewise Function within NDSolve

So I am quite new to Mathematica and programming in general and I am running into an issue while trying to use the numerical diff eq solver (NDSolve) within mathematica. This is what my code looks like: NDSolve[ {Paorta'[t] == (1/ Caorta)[(Pheart[t] - Paorta[t])/ Piecewise[{{Ro, Pheart[t] - Paorta[t] > 0}, {x*Ro, Pheart[t] - Paorta[t] < 0}}, .25] - Paorta[t]/Rsystemic], Paorta[0] == 120}, {Paorta[t]}, {t, 0, 6} ] Now, I am getting the error "NDSolve::ndnum: Encountered non-numerical value for a derivative at t == 0. I am pretty sure the reason for this is the fact that I have the function I am trying to solve for as one of the conditions in the piecewise function but I need that to be there for the purposes of the project I am working on. Is there any way to get around this issue? And is this even what is causing my issue? These are the definitions I have used previously in the code: Ro = .25; Caorta = 1/.48; k = 110; \[Omega] = 2 \[Pi]; x = 8000;

replacement - Replace a column in table with a list of numbers?

I have a Table of values e.g. {{x,y,z},{x,y,z},{x,y,z}…} How do I replace the the "z" column with a List of values? Answer fun[u_, c_, r_] := Transpose@ReplacePart[Transpose[u], c -> r] Example: list = {{a, b, c}, {a, b, c}, {a, b, c}}; fun[list, 1, Range[3]] yields: {{1, b, c}, {2, b, c}, {3, b, c}} This requires the replacement column be the same length (which I have assumed as intention) as final transpose will fail if this is not the case.

polyhedra - Any packages for vertex enumeration on Mathematica?

My work requires me to enumerate all vertices of a polytope defined by linear inequalities from time to time. And I'm mainly working with _Mathematica 9.0 on Mac OS X 10.9 . So I wonder are there any packages in Mathematica which can be used for vertex enumeration . I know a very old Mathematica package VertexEnum.m which can be found from here . I have tested the package and it still works on Mathematica 9.0 with a minor modification. The main drawback of this package is its efficiency. It's much slower than calling MPT3 toolbox in MATLAB via MATLink package on Mathematica . As far as I know, they share the same vertex enumeration algorithm, the Double Description Method of Motzkin et al. . Currently I have several questions in mind. I tried to Google them but I failed to get answers. Any comments or suggestions are most welcome. Are there any packages in Mathematica doing vertex enumeration on _Mathematica? Is there a latest VertexEnum.m package whose efficiency is

bugs - How symbol lookup actually works

Bug introduced in V6 and fixed in V11.3 The behavior indeed changed but now the documentation is clear about it. This code is inconsistent with the description from Power Programming with Mathematica : x = 5; temp`x = 6; Begin["temp`"] {x, Global`x, temp`x} The result in my Mathematica session is {5, 5, 6} , but it's {6, 5, 6} in Section 8.1.1 of Power Programming with Mathematica (page 231 of the hardcopy or page 249 of the PDF). Answer This behaviour has changed since that book was published. I am writing this additional answer to make it clear how Mathematica 9 searches contexts for symbols and that even the current version 9 documentation is incorrect in describing this. How symbol lookup actually works When you enter a symbol name such as x , Mathematica will check if a symbol with this name already exists. It will first search the contexts from $ContextPath for x , one by one. If it doesn't find it there, it'll search the context from $Context for it.

May I restrict caching to disk when memory runs low?

An hour ago, I had to hard reset my laptop again because Mathematica froze the system again. When import a large file or make a mistake that produces huge arrays with complicated entries etc., I often see that the system becomes unresponsive. Holding the power button for seconds seems to be the only solution. I was forced to do so about 20 times in recent 3 months, because of a project I was working at. Today, chkdsk had to start already when Windows was starting which I think is creepy. No errors found on the disk, thank God. Is there a way to constrain this behavior so that it doesn't become hopeless? Some setting which makes Mathematica say "I give up, low memory" instead of doing the impossible and suicidal caching? Answer Use MemoryConstrained MemoryConstrained[yourCode, memoryLimit, actionOnMemoryLimitOverflow]

plotting - Marking points of intersection between two curves

I'm trying to illustrate the solutions numerically and graphically for an equation such as Tan[x] == x . I think I did everything ok except I wanted to mark each intersection between Tan[x] and x . Does anyone know how such a thing can be done? Answer Edited to make it a function. For the strange Exclusions specification I use below, see my answer here . Thanks to @Oleksandr and @JM for their great comments. plInters[{f1_, f2_}, {min_, max_}] := Module[{sol, x}, sol = x /. NSolve[f1[x] == f2[x] && min < x < max, x]; Framed@Show[ ListPlot[{#, f1[#]} & /@ sol, PlotStyle -> PointSize[Large]], Plot[{f1[x], f2[x]}, {x, min, max}, Exclusions -> {True, f2[x] == 10, f1[x] == 10}] ] ] GraphicsRow[plInters[#, {-10, 10}] & /@ {{# &, Tan}, {Tan, Coth}, {Sin, 1/# &}}]

Mathematica periodic moving map

I am pleased to have MovingMap in Mathematica 10. But, today, I encountered the problem that needs MovingMap with a periodic boundary condition. To be specific, Consider the following example. MovingMap[ f, Range[3], {2} ] will gives the result {f[{1, 2}], f[{2, 3}], f[{3, 4}]} . However, what I want to get is {f[{1, 2}], f[{2, 3}], f[{3, 4}], f[{4,1}]} . One of the easiest and straightforward way would be calculating the last one and then join the lists together. But I want to know if there is more elegant way to do it. (I checked the optional arguments of MovingMap but I couldn't find a solution.) Answer "Reflected" padding works as desired but "Periodic" padding is missed. There is corresponding definition for "Reflected" RandomProcesses`TemporalDataUtilitiesDump`toCannonicalPadding[ RandomProcesses`TemporalDataUtilitiesDump`td_, "Reflected", RandomProcesses`TemporalDataUtilitiesDump`w_, RandomProcesses`TemporalDataUtilitiesDump

grid layouts - Pretty printing of factorization output

I want to create a table of factorization of certain numbers $f(n)$ with traditional pretty printing output (more or less same as what is used to display in textbooks). For example consider FactorInteger[Table[n!, {n, 0, 5}]] standard output is {{{1, 1}}, {{1, 1}}, {{2, 1}}, {{2, 1}, {3, 1}}, {{2, 3}, {3, 1}}, {{2, 3}, {3, 1}, {5, 1}}} and the so-called traditional output is some kind of matrix-looking format, with first column the base and the second column the exponent. How do I create a suitable display output as in $$\begin{array}{cc} \text{N} & \text{factorization of N!} \\ \hline 0 & 1 \\ \hline 1 & 1 \\ \hline 2 & 2 \\ \hline 3 & 2, 3 \\ \hline 4 & 2^3, 3 \\ \hline 5 & 2^3, 3,5 \\ \hline \end{array}$$ The lines and heading etc. are not the important aspects, the easily readable output is. Answer data = FactorInteger[Table[n!, {n, 0, 5}]]; leftCol = Prepend[Range[0, Length[data] - 1], "N"]; rigthCol = Prepend[ Row[HoldForm[#]^#2 & @@

calculus and analysis - Integrate returns imaginary answer for smooth, real function

Bug introduced in 7 or earlier and persisting through 12.0.0.0 or later I'm trying to evaluate the integral: $$\int_0^{\infty} \frac{1}{4 b \sqrt{\pi} r} e^{-(b-r)^2}(e^{4 b r} - 1) \mathrm{d}r$$ with $b>0$ . Integrate[(E^-(b + r)^2 (-1 + E^(4 b r)))/(4 b Sqrt[π] r), {r, 0, ∞}, Assumptions -> b > 0] (* -((I E^-b^2 Sqrt[π])/(4 b)) *) Unfortunately, the function being integrated is purely real and smooth, so the answer should be real, but the one provided by Mathematica is purely imaginary. -((I E^-b^2 Sqrt[π])/(4 b)) /. b -> 1/(π + E) // N (* 0. - 2.52206 I *) NIntegrate is able to correctly return real values. NIntegrate[-(E^-(b + r)^2/(4 b Sqrt[π] r)) + E^(4 b r - (b + r)^2)/(4 b Sqrt[π] r) /. b -> 1/(π + E), {r, 0, ∞}] (* 0.490405 *) Unlike some other cases I have seen, Mathematica does not know the elementary antiderivative for this function, so I cannot tell whether some issue with discontinuities or branch cuts is causing this problem. What explai

plotting - How to color a contour plot over a subset of colors displayed in the bar legend

This seems real easy but I can't find the answer. I have a few contour plots that I am combining and want to use only one bar legend that captures all the values. Given that I know the range of values, how to get the colors to correspond so that, say, if one plot only ranges over 1/3 of the total range, it only displays 1/3 of the range of colors. The following code only plots the BarLegend correctly but leaves the colors in the contour plot unchanged: ContourPlot[X^2+Y^2,{X,-3,3},{Y,-3,3},PlotLegends->BarLegend[{"LakeColors",{0, 100}}, 10]] Edit: I should have been more precise. Here is a more explicit example. The goal is to make the contour colors quantitatively consistent between the plots. h1 = ContourPlot[X^2 + Y^2, {X, -3, 3}, {Y, -3, 3}, PlotLegends -> Automatic]; h2 = ContourPlot[X^2 + Y^2, {X, -5, 5}, {Y, -5, 5}, PlotLegends -> Automatic]; GraphicsRow[{h1, h2}, ImageSize -> 500] As @David_Park mentions, I need to use ColorFunction. But I don't kn

list manipulation - 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

Is there a "No Units" (i.e., dimensionless) unit?

I would like to be able to call the Quantity function with a null unit so that it returns the original dimensionless value. For example, Quantity[3.0,"NoUnits"] would return 3.0 . Is there a dimensionless unit? Answer I believe you can use "DimensionlessUnit" to get the desired result: Quantity[3, "DimensionlessUnit"] 3 (note this is the unit produced by QuantityUnit on a dimensionless value): QuantityUnit[3] "DimensionlessUnit"

What are all the "magic" Symbols in the Mathematica language?

Leonid Shifrin once wrote (excerpted): ( Unevaluated ) is one of a very few "magic symbols", along with Sequence and Evaluate - these are deeply wired into the system and can not be easily replicated or blocked, unlike Hold - in that sense, Unevaluated is more fundamental. HoldPattern is a normal (usual) head with HoldAll attribute for the purposes of evaluation, but its magic shows in the pattern-matching: it is invisible to the pattern-matcher, and is very important ingredient of the language since it allows pattern-matcher to be consistent with the evaluation process. David B. Wagner writes : The symbols Evaluate , Unevaluated , and Sequence are magic cookies. This is a whimsical term used by computer scientists to refer to any type of value that has special significance to the software system of which it is a part. The behavior of these symbols is not the result of any values or attributes they possess; rather, it is "wired into" the kernel. This implie