Skip to main content

Posts

Showing posts from August, 2014

plotting - How to get grid lines at all (log) tick marks in Version 10?

Bug introduced in 10.0.0 and fixed in 10.1.0 Update: It seems that only versions 10.0.0, 10.0.1, and 10.0.2 are affected by this problem. For 10.0.0 there is no general solution known to me due to Why does GridLines option fail with Function? For versions 10.0.1 and 10.0.2 a solution is the PlotTheme method in my self-answer . (The enhanced definition in that answer may still be of general interest.) In version 10.1.0 and later both GridLines -> All and GridLines -> Full produce the desired result, as shown in pmsoltani's now Accepted answer . In Version 7 using GridLines -> Automatic (or All ) would put a grid line at every log-spaced tick mark: LogPlot[x^x, {x, 1, 5}, GridLinesStyle -> LightGray, GridLines -> Automatic, Frame -> True] In Version 10 this is no longer the case: What is the simplest way to recover the old behavior? Answer You can, also, use GridLines -> Full option (in version 10.3, at least): LogPlot[x^x, {x, 1, 5}, GridLinesStyle -&

output formatting - Easiest Way to Use ShowGroupOpener in Mathematica

I currently edit manually the cell contents of a notebook (Ctrl+Shift+A or Cmd+Shift+A) to "recycle" cells containing the ShowGroupOpener option. Is there an easier way to create documents hiding contents under that type of icon? Answer Unless you want group openers for all groups -- which you probably don't, since that would put one at the very top level for the entire notebook -- then you can edit the notebook's style sheet, select the kind of cell (Section, Subsection, e.g.) for which you want the group opener, and then use the Option Inspector on that cell in the style sheet to include ShowGroupOpener. You could do this either for a particular notebook by using the menu command Format > Edit StyleSheet or you could make a copy of a standard style sheet, modify that, and then select it as the style sheet for whatever notebooks you choose. (I'd advise against directly modifying any of the Wolfram-supplied style sheets.) I can give a more detailed explanatio

list manipulation - Why can't NumberQ be used as the head of a pattern?

Consider the following: list={1/First[{}], 1, 2, 1/First[{}], 3}; DeleteCases[list,_NumberQ] I wanted to remove all cases, which did not match _!NumberQ (e.g. 1/First[{}] ), in the first place. But after DeleteCases[list,_!NumberQ] did not work, I tried it with DeleteCases[list,_NumberQ] , just to see whether that would work...didn't. What I am doing wrong? Answer The syntax _foo indicates that you're looking for a pattern with the head foo . NumberQ is not a Head , but a test returning a boolean True or False depending on whether the expression is a number or not. So you'd have to use it with PatternTest as _?NumberQ . For your example, the following should work: Cases[list, _?NumberQ] If you wanted to stick with DeleteCases , then you'll have to negate the test using either of the three constructs below: DeleteCases[list, _?(Composition[Not, NumberQ])] DeleteCases[list, _?(! NumberQ[#] &)] DeleteCases[list, Except[_?NumberQ]] Beware that ? has a very hi

differential equations - Numerically solving a system of many coupled non-linear ODEs efficiently?

I'm studying a fairly typical problem: a chain of $n$ coupled, non-linear oscillators. Since I want to look at open boundary conditions, the equations of motion for the position of the first and the last oscillator are specified separately: \begin{align} \ddot{x}_1(t) &= -(x_1(t) - x_2(t)) - V(x_1(t)) + f(t) \\ \ddot{x}_n(t) &= -(x_n(t) - x_{n-1}(t)) - V(x_n(t)) \end{align} where $V(x(t))$ specifies the on-site non-linearity and $f(t)$ is an external driving term. The remaining equations of motion are: \begin{equation} \ddot{x}_i(t) = -(2 x_i(t) - x_{i+1}(t) - x_{i-1}(t)) - V(x_i(t)), \quad i=2,\dots,n-1 \end{equation} This is the simplest version of a more general problem I'm trying to understand, but I want to first see how to most efficiently simulate this problem numerically using Mathematica . I've seen many papers where such problems are solved using Molecular Dynamics (MD) simulations where the equations of motions are solved using a Verlet integration al

map - Using MapIndexed only at certain elements of a list

MapIndexed is a very handy built-in function. Suppose that I have the following list, called list : list = {10, 20, 30, 40}; I can use MapIndexed to map an arbitrary function f across list : {f[10, {1}], f[20, {2}], f[30, {3}], f[40, {4}]} where the second argument to f is the part specification of each element of the list. But, now, what if I would like to use MapIndexed only at certain elements? Suppose, for example, that I want to apply MapIndexed to only the second and third elements of list , obtaining the following: {10, f[20, {2}], f[30, {3}], 40} Unfortunately, there is no built-in " MapAtIndexed ", as far as I can tell. What is a simple way to accomplish this? Thanks for your time. Answer If does the job and is simple enough: MapIndexed[If[2 ≤ First@#2 ≤ 3, f[#, #2], #] &, list] (* {10, f[20, {2}], f[30, {3}], 40} *)

Excel column label from integer

I would like to create a function in Mathematica , which returns the equivalent Excel column label (e.g., A, Z, AA, AZ, and so on) given a column number. I think it can be done with IntegerString[10,26] , but this representation set of this chars is 0 to 9 and then a to z. However, Excel uses only A to Z. How can this be done? Answer Ok, well, I only needed the inverse function so far and have implemented it as: FromExcelCol[col_String] := FromDigits[ToCharacterCode[col] - 64, 26] It runs fine because FromDigits does not complain about characters larger than base-1. However, the other way round seems to be more tricky. The leading digit runs from 0 to 26 (1 to 27 if you want -> base 27), but only as long as it is leading. Then it runs as a trailing digit from 1 to 26. I have not found an elegant, non-iterative solution so far. I was hesitating to paste my (ugly but working) piece of code, but maybe it encourages others to look for a nice solution. :) ToExcelCol[n_Integer] := Modul

plotting - Need 4D plot (3D + color for function)

I have a function f(x,y,z) of three variables and some constants: P1 = 630*10^6; a1 = 6.1; deltaf = 680*10^-28; rho = 13600; Na = 6.03*10^23; M = 270; N1 = rho*Na/M; sigmaf = N1*deltaf; v1 = 161/(0.7958)^3; Ef = 3.2*10^-11; A1 = 3.87*P1/(v1*Ef*sigmaf); flux1[x_, y_, z_] := A1*Cos[\[Pi]*x/a1]*Cos[\[Pi]*y/a1]*Cos[\[Pi]*z/a1]; I want to plot this function in 3D frame with color to represent the value of a f(x,y,z) at each triplet point. And need color bar to show variation. Give me suggestions. I have used the following command but it is not working properly. ContourPlot3D[ A1*Cos[\[Pi]*x/a1]*Cos[\[Pi]*y/a1]*Cos[\[Pi]*z/a1], {x, -3, 3}, {y, -3, 3}, {z, -3, 3}, ColorFunction -> (ColorData["TemperatureMap"][#3] &)] I want the plot to look like this: (It is the last plot on this page.)

bugs - What calendar is Mathematica using for dates in the distant past?

It appears that Mathematica treats all dates as proleptic Gregorian dates by default, a hypothesis that can be easily tested by using AbsoluteTime to compute the Julian Day : jd[t_] := AbsoluteTime[t]/86400 + 2.4150205*^6 but, while this works for recent dates and for some older ones, it yields results that differ from the correct result for some older dates by exactly a day jd[{2012, 11, 24, 12}] - 2456256 0 jd[{1100, 11, 24, 12, 0, 0}] - 2123154 0 jd[{-3000, 11, 24, 12, 0, 0}] - 625660 1 notably for the reference date, 12:00 Universal Time on January 1, 4713 BCE in the proleptic Julian calendar (-4713-11-24 in the proleptic Gregorian calendar): jd[{-4713, 11, 24, 12, 0, 0}] 1 What calendar is Mathematica using for these older dates, if not the proleptic Gregorian calendar? Here, perhaps is another clue: DateList[{-4713, 11, 24, 12, 0, 0}] {-4713, 11, 25, 12, 0, 0} DateList[{-3000, 11, 24, 12, 0, 0}] {-3000, 11, 25, 12, 0, 0} I'm no calendar expert, but this "canonicali

equation solving - Simplify not evaluating completely with Square roots

Here's a simple question. It's no longer high priority that I know this, but it's something that can come in handy later on. Simplify[a > Sqrt[b]/c + d, a < Sqrt[b]/c + d] or Simplify[Sequence @@ ({a > n, a < n} /. {n -> Sqrt[b]/c + d})] or n = Sqrt[b]/c + d; Simplify[a > n, a < n] all outputs: Out: a > Sqrt[b]/c + d while Simplify[a > m, a < m] outputs Out: False How come? This isn't an issue of not considering the negative root. The expressions are identical. As demonstrated by Simplify[a > m, a < m], replacing m with more complex expressions aside from having the Sqrt function. In fact, if I use Surd , no matter the nth root, even or odd, or square root, Simplify will evaluate completely into False. Why? Is this something that I can fix using Upvalues? -- Finally remember what the "overloading" feature was called. Answer The assumptions mechanism used by Simplify will not try to prove or disprove an inequality if th

Export ContourPlot as DXF

I'm having some trouble exporting a ContourPlot as a .DXF (to be used in AutoCAD). My code is: LG3 = ContourPlot[1/2 - Sum[Sinc[(n \[Pi])/2] Cos[n (1 x + 4 ArcTan[y, x])], {n, 1, 200}] == 0.5, {x, -20, 20}, {y, -20, 20}, PlotPoints -> 100] SetDirectory[NotebookDirectory[]]; Export["LG3.dxf", LG3]; The relevant output is: Export::nodta: Graphics3D contains no data that can be exported to the DXF format. >> Any help would be appreciated. Thanks. Answer DXF export is somewhat idiosyncratic (3D only) and slow. For the following I´ve reduced PlotPoints to make casual experimenting less glacial. The general idea is to extract all Line primitives and elevate coordinate tuples to 3D. LG3 = ContourPlot[ 1/2 - Sum[Sinc[(n π)/2] Cos[n (1 x + 4 ArcTan[y, x])], {n, 1, 200}] == 0.5, {x, -20, 20}, {y, -20, 20}, PlotPoints -> 20]; threed = Graphics3D[Cases[Normal[LG3[[1]]], _Line, Infinity] /. {x_?NumericQ, y_?NumericQ} :> {x, y, 0}] Export["LG3.dxf&

matrix - Multiplying SparseArray by negative number Crashes Kernel

Bug introduced in 9.0 and persisting through 11.0 Can anyone reproduce the following bug, or figure out a work-around. The following crashes the kernel on both Mathematica 10 and 11, on my macs, running OSX 10.10 and 10.11: Cl[len_Integer] := SparseArray[{ Band[{1, 1}] -> Table[-2., {len}], Band[{1, 2}] -> Table[1. + 1./(2 j - 1.), {j, 1., len - 1}], Band[{2, 1}] -> Table[1. - 1./(2 j + 1.), {j, 1., len - 1}]}, {len, len}] s = Cl[30] t = -2. s The last line (simply multiplying the matrix by a negative number) causes the crash. I have tried changing the matrix -- and some changes help, other do not. Multiplying by positive numbers is fine. Answer This is a bug. From @ilian's comment: Workaround: turn off the Suggestions bar.

Compile from String using function arguments

I want to return a Compile d function built from a string that uses values of local variables: f[x_] := Module[{code}, code = "Compile[{},x,CompilationTarget->\"C\"]"; ToExpression[code] ]; While f[1] is a compiled function, f[1][] yields an error due to x . Plain use of Compile works: g[x_] := Module[{}, Compile[{}, x, CompilationTarget -> "C"] ]; with g[1][] returning 1 . Why does the compilation from string not recognize the local variable? PS: I can work around this by inserting ToString[x,InputForm] into the string, but would like to understand better what happens. PPS: In the original code, both parameters and code string are more involved. Answer I think that J.M.s advice to avoid using strings for that kind of meta-programming is the best answer you can get for that question. Looking up the meta-programming question to gather ideas how you can better tackle your specific problem is certainly worth the effort, for completene

algebra - How can I implement anti-commuting (Grassmann) numbers (variables)?

I am looking for a way to define anti-commuting numbers (variables) in Mathematica. Let say we have a set of four variables like ${x_1,x_2,x_3,x_4}$ from which I need to get all possible permutations, then multiply them so they appear as a sum as $\qquad x_1*x_2*x_3*x_4+x_1*x_2*x_4*x_3+(22\,{\rm terms})$ But these variables are Grassmann anti-commutative, so whenever we interchange any two of them we should get a negative sign, i.e., $x_1*x_2 = -x_2*x_1$, for example the above expression should appear as $\qquad x_1*x_2*x_3*x_4-x_1*x_2*x_4*x_3+(22\,{\rm terms})$ I know how to permute the variables, but I do not know how get their signs correctly. Any ideas?

vector - How to define an orthogonal basis in the right way?

I am trying to work with the vector notation without defining vector components explicitly. $Assumptions = (x | y | z) \[Element] Vectors[3] The vectors x , y and z are unit and orthogonal. To set this I'm using the UpSet command: x.x^=1; x.y^=0; x.z^=0; y.x^=0; y.y^=1; y.z^=0; z.x^=0; z.y^=0; z.z^=1; Most of the needed vector operations work correctly in this case, for example: TensorProduct[x, y].(2 y + z) // TensorExpand evaluates correctly to 2 x . However, (x,y,z) is not a "complete" coordinate system without defining "handness", so the cross product doesn't work. Cross[x, y] should evaluate to z , Cross[z,y] to -x and so on for a "right hand" coordinate system. How do I implement this? I am using Mathematica 9, but I can upgrade to 10 if needed. edit: As the response to one the comments: I'm working with the vector fields, say s and p , defined in the terms of x,y,z . I need to calculate matrix elements such as s.T.t where T ,

number representation - Maintaining working precision in my program

I am badly stuck with this program I am writing. I want output of program below to be precise up to 25 digits after decimal point. I am supplying all inputs with precision 25. But after each iteration of main for loop, precision keeps on decreasing by some points. And as a result in about 100 iterations precision comes down to 0. I tried everything that I can think of including explicitly setting precision using SetPrecision in f1,f2,f3,N1,N2,N3,a . That would produce output but it's not correct as SetPrecision is just padding the digits from right. Appreciate any help/suggestions. Thankx. Input: Clear["Global`*"]; order = 0.89`25; parameter = 27.3`25; ic = {1000000001/100000000`25., 10, 10}; SIZE = 100; Program: AbsoluteTiming[alph = bet = gam = order; h = 2/100; omeg = -2667/1000; mu = 10; A = parameter; B = 1; Array[y1, SIZE, 0]; y1[0] = ic[[1]]; Array[y2, SIZE, 0]; y2[0] = ic[[2]]; Array[y3, SIZE, 0]; y3[0] = ic[[3]]; a[0 _, k_] := (k - 1)^(alph + 1) - (k

plotting - Help remove annoying vertical lines in a piecewise plot

I use the following codes to define and plot three piecewise functions. list1 = Join[ Table[{(j - 1)/2^1, (j - 1)/2^1 <= E^x < j/2^1}, {j, 1, 1*2^1}], {{1, E^x >= 1}}]; list2 = Join[ Table[{(j - 1)/2^2, (j - 1)/2^2 <= E^x < j/2^2}, {j, 1, 2*2^2}], {{2, E^x >= 2}}]; list3 = Join[ Table[{(j - 1)/2^3, (j - 1)/2^3 <= E^x < j/2^3}, {j, 1, 3*2^3}], {{3, E^x >= 3}}]; p1 = Piecewise[list1]; p2 = Piecewise[list2]; p3 = Piecewise[list3]; Plot[p1, {x, -3, 3}, AspectRatio -> Automatic] Plot[p2, {x, -3, 3}, AspectRatio -> Automatic] Plot[p3, {x, -3, 3}, AspectRatio -> Automatic] p1 and p2 just come out fine, while p3 is messy, with end points of each horizontal lines connected by vertical lines. Thank you! Answer Using @Rojo's answer to my question here you don't need to know a priori where the exclusions are: plot = Plot[p3, {x, -3, 3}, PlotPoints -> 1000]; pp = With[{multiplier = {AspectRatio, PlotRange} /. AbsoluteOpt

calculus and analysis - Mathematica 9 can't integrate this function but earlier versions could

Integrate[ ArcTan[x]/(1 + x) Log[(1 + x^2)/2], {x, -1, 1}] I used Mathematica 9.0.1 on Windows7 32bit , Mathematica 9 cannot compute this, but Mathematica 8 gives Pi^3/96 , is this a bug? Answer This issue reminds many similar problems with Integrate . We have in Mathematica 8.0.4 : Integrate[ ArcTan[x]/(1 + x) Log[(1 + x^2)/2], {x, -1, 1}] Pi^3/96 However in Mathematica 9.0.1 it takes quite a long time yielding a different result: Integrate[ ArcTan[x]/(1 + x) Log[(1 + x^2)/2], {x, -1, 1}] Infinity This is a bug, we can compare it with the NIntegrate result which yields the number numerically the same as in ver. 8 . Of course the result should be the same if we substitute ArcTan by its equivalent: TrigToExp[ ArcTan[x] ] 1/2 I Log[1 - I x] - 1/2 I Log[1 + I x] but now the result is the same as in ver. 8 : Integrate[ TrigToExp[ ArcTan[x]]/(1 + x) Log[(1 + x^2)/2], {x, -1, 1}] Pi^3/96

front end - Is it possible to cause a notebook to be hidden when pressing the close button?

Is it possible to cause a notebook to be hidden ( Visible -> False ) instead of closing it when pressing the close button in the title bar? The Messages window seems to work this way. The Notebooks[] function will list it even when it is not visible (or it has been "closed"). Is this special behaviour, or is it possible to make any notebook window behave like this? Motivation: As part of a user interface, I would like to gradually collect some information into a notebook (lets call it a "log-notebook"). The visibility of the log-notebook would be toggled with a button. This log-notebook should persist across kernel sessions, but not across front end sessions (it will never be saved).

wolfram alpha queries - Can Mathematica solve functional equations with nested variable?

First, inline free form input can solve these equations: But it seems no native Mathematica function can solve these, there is even an error page for equations of this form (nestdv). Now my question is: Is this a function implemented only in Wolfram Alpha but not Mathematica? How can we solve these equations in Mathematica (natively)? Answer It doesn't seem there is a one line solution but we can adapt W|A to give a result similar to DSolve and friends. fSolve[eq_Equal] := fSolve @ ToString@eq; fSolve[eq_String] := Values[ WolframAlpha[ "solve " <> eq, {"SolutionAsAFunctionalEquation", "FormulaData"} ] ] /. Hold[Equal[f_, d_]] :> f -> d /. { Subscript[\[ScriptC], n_] :> C[n], \[ScriptC] -> C[0] } fSolve["f[f[x]] == f[1 + x]"] {f[x] -> 1 + x} fSolve[f[f[x]] == x] {{ f[x] -> -x + C[0], f[x] -> C[0]/x, f[x] -> (-x + C[1])/(1 + x C[2]), f[x] -> 1/2 (x C[1] + Sqrt[-4 x^2 + C[1]^2 + C[2]]), f[x]

scripting - How to run multiple scripts in a row from command line using the same kernel?

Here is my shell script so far (I am using MacOSX): #!/bin/sh math="/Applications/Mathematica.app/Contents/MacOS/MathKernel" $math -run "< output The two scripts I want to run in a row are script1.wl and script2.wl. The above seems to only run script1.wl Anything obvious I am missing ? Answer I can't see any syntax on this page for using 2 files with the -script option (and as MB1965 points out, the help does say that only one script file can be used with the -script option). I do have some experience running WL files from the command line in Mathematica in batch mode, all of which I learned from Jens's page here . If I create a file called "script1.wl" with the contents x1 = 3; x2 = 4; and another file in the same directory, "script2.wl", with Print[x1 + x2]; Exit[] and then run this command from the same directory math -noprompt -run "< output where I've set math up as an alias in my shell to the MathKernel applicati

equation solving - Find all roots of a function with parabolic cylinder functions in a range of the variable

I want to find all roots of a function involving Parabolic Cylinder Functions. In what follows, I define 2 variables $\xi1$ and $\xi2$, which in turn depend on $\omega$. My function is then defined as f. I go on defining g and h (where I take specific values for my parameters $M$ and $\lambda$ which are real and positive. I then plot the real and imaginary part of h to locate the roots. I would like, however, to be able to find all roots of $Im[h]$ (The real part is essentially 0) in a range of $\omega$, say from 0 to 50. ξ1[ ω_] := (-1 + I) (ω/Sqrt[λ] - Sqrt[λ]/2) ξ2[ ω_] := (-1 + I) (ω/Sqrt[λ] + Sqrt[λ]/2) f := (I ParabolicCylinderD[I M/(2 λ), I ξ1[ ω]] - Sqrt[M/λ]*(-I - 1)/2* ParabolicCylinderD[I M/(2 λ) - 1, I ξ1[ ω]])*( ParabolicCylinderD[-I M/(2 λ), ξ2[ ω]] + I *Sqrt[M/λ]*(I - 1)/2* ParabolicCylinderD[-I M/(2 λ) - 1, ξ2[ ω]]) + (I ParabolicCylinderD[ I M/(2 λ), I ξ2[ ω]] + Sqrt[M/λ]*(-I - 1)/2*ParabolicCylinderD[I M/(2 λ) - 1, I ξ2[ ω]])*(ParabolicCylinde

graphs and networks - Ordering vertices in GraphPlot

I'm new here, so forgive me if this question is not well-posed/duplicates an earlier question - although I've searched for similar questions without success. I'm trying to present a plot of connections between elements (correlations between student performance on a set of test questions, actually). It's something like (with options omitted): test = {{1 -> 5, 1}, {4 -> 3, 3.6}, {6 -> 8, 1}, {2 -> 4, 2}, {2 -> 5, 2.5}, {5 -> 4, 0.9}, {7 -> 8, 2}, {3 -> 8, 1}, {8 -> 2, 1}}; GraphPlot[test, Method -> "CircularEmbedding", VertexLabeling -> True, EdgeLabeling -> False] where the {1,2,3,...} are the labels for my questions. I want to order the vertices in ascending order (1,2,3,...), i.e. I want vertices with consecutive labels to be adjacent on the circle, like a clock - i.e. as in the image below, which I had to construct by making the connections more or less consecutive: test2 = {{1 -> 2, 1}, {3 -> 4, 3.6}, {5 ->

latex - Nonacceptance by StackExchange site of Mathematica TeXForm employing unicode

When I apply the Mathematica command TeXForm to DifferenceRoot[ Function[{\[FormalY], \[FormalN]}, {9 (1 + \[FormalN])^2 \ \[FormalY][\[FormalN]] - 60 (3 + 2 \[FormalN])^2 \[FormalY][ 1 + \[FormalN]] + (3840 + 4096 \[FormalN] + 1024 \[FormalN]^2) \[FormalY][2 + \[FormalN]] == 0, \[FormalY][1] == -(9/64), \[FormalY][2] == -(81/4096)}]][bb] I obtained \text{DifferenceRoot}\left[\{\unicode{f818},\unicode{f80d}\}\unicode{f4a1}\left\{\left(10 24 \unicode{f80d}^2+4096 \unicode{f80d}+3840\right) \unicode{f818}(\unicode{f80d}+2)+9 (\unicode{f80d}+1)^2 \unicode{f818}(\unicode{f80d})-60 (2 \unicode{f80d}+3)^2 \unicode{f818}(\unicode{f80d}+1)=0,\unicode{f818}(1)=-\frac{9}{64},\unicode{f818}(2)=- \frac{81}{4096}\right\}\right][\text{bb}] which was not accepted as the input to \begin{equation} \end{equation} in my question https://mathoverflow.net/questions/322958/compute-the-two-fold-partial-integral-where-the-three-fold-full-integral-is-kno/323011#323011

manipulate - trouble with Dynamic range in SetterBar

It appears that I can set the range to a Dynamic variable in a Manipulate control, but not in a SetterBar control? : Manipulate[ tick; Dynamic@If[ tabNumber == dynTab, Plot[ x^2, {x, 0, 1}], Plot[ 1 - x^2, {x, 0, 1}]] , TabView[ { "dynamic range" -> Column[ tabNumber = dynTab ; { Row[{Manipulator[ Dynamic[m2, (m2 = #; tick = Not[tick]) &], {2, Dynamic@range, 2}], " ", Dynamic[m2] }], Row[{SetterBar[Dynamic[s2, (s2 = #; tick = Not[tick]) &], Range[Dynamic@range]], " ", Dynamic[s1] }] }], "static range" -> Column[ tabNumber = staticTab ; { Row[{Manipulator[ Dynamic[m1, (m1 = #; tick = Not[tick]) &], {2, 8, 2}], " ", Dynamic[m1] }], Row[{SetterBar[Dynamic[s1, (s1 = #; tick = Not[tick]) &], Range[8]], " ", Dynamic[s1] }] }] }, Dynamic @tabNumber ] , {{tick, False}, None} , {{tabNumber, 1}, None}, {{d

plotting - Octahedra+tetrahedra filling tessellations in 3D

This is called the quasiregular space-filling tessellations in 3D: formed by and Are there any smart ways to do a Mathematica figure drawing this?

numerical integration - Error in integral representation of Appell's series

It was originally asked here . According to About the confluent versions of Appell Hypergeometric Function and Lauricella Functions the integral $$\int_0^1t^{a-1}(1-t)^{c-a-1}(1-xt)^{-b}e^{yt}~dt $$ can be expressed as $$\int_0^1t^{a-1}(1-t)^{c-a-1}(1-xt)^{-b}e^{yt}~dt=\dfrac{\Gamma(a)\Gamma(c-a)}{\Gamma(c)}\lim\limits_{k\to\infty}F_1\left(a,b,k,c;x,\dfrac{y}{k}\right).$$ It look like true , but gives numeric error. Look that, calculated by Mathematica: F[a_?NumericQ, b_?NumericQ, c_?NumericQ, x_?NumericQ, y_?NumericQ] := NIntegrate[t^(a - 1) (1 - t)^(c - a - 1) (1 - x t)^(-b) Exp[ y t], {t, 0, 1}] N[F[3/2, 1, 2, .4, .3], 20] {2.8964403550198865`} G[a_?NumericQ, b_?NumericQ, c_?NumericQ, x_?NumericQ, y_?NumericQ] := Gamma[a] Gamma[c - a]/Gamma[c] Limit[AppellF1[a, b, k, c, x, y/k],k -> Infinity] N[G[3/2, 1, 2, .4, .3], 20] {2.2854650559595466`} where I was careful to ensure that $|x|<1,|y|<1$, and $\text{Re}(c)>\text{Re}(a)>0$, which are the condition of $F_1$.Note th

image processing - Generating x,y coordinates for an edge detection

I'd like to be able to process a number of graphics that have edge contours and output a list of $x$, $y$ coordinates to be used for generating a spline in another program, or in Mathematica, to make a SOR, prism, etc. Essentially, given a photo of a turned spindle, output the radius as a function of length. I was working with code from Get x and z coordinate from an image and make a parametric surface . I've got to the point where I can output a graph of the "height" vs length, but I need to get a list of coordinates. I suppose being able to draw a line to measure from in the case of tricky graphics or slanted [eventual] centers of rotation would be a helpful feature.

numerics - Solving a steady-state viscous Burger's equation with NDSolve

A steady-state viscous Burger's equation is given by $$ u\,u'=\nu \,u'', \quad x\in (-1,1), $$ $$ u(-1)=1+\delta,\quad u(1)=-1.$$ Here $\nu>0$ is the viscosity, $\delta>0$ is a small perturbation and $u$ is the solution. This ODE problem has a unique solution: $$ u(x)=-A\,\text{tanh}\left(\frac{A}{2\nu}(x-z)\right), $$ where $A>0$ and $z>0$ are constants determined by the boundary conditions: $$ A\,\text{tanh}\left(\frac{A}{2\nu}(1+z)\right)=1+\delta,\quad A\,\text{tanh}\left(\frac{A}{2\nu}(1-z)\right)=1. $$ The exact solution can be plotted in Mathematica: Azex[nu_, delta_] := Quiet[{a, zz} /. Flatten@NSolve[{a*Tanh[a*(1 + zz)/(2*nu)] == 1 + delta, a*Tanh[a*(1 - zz)/(2*nu)] == 1, a > 0, zz > 0}, {a, zz}, Reals]] nu = 0.05; {A, zex} = Azex[nu, 0.01]; Plot[-A*Tanh[A*(x - zex)/(2*nu)], {x, -1, 1}, PlotStyle -> Black, PlotRange -> All, AxesLabel -> {"x", "u(x)"}, BaseStyle -> {Bold, FontSize -> 12}, Plo

computational geometry - Find the volume of Phobos and Deimos

How can we calculate the volume of a 3D object using the new-in-10 computational geometry functions? For simple objects this works: shuttle = ExampleData[{"Geometry3D", "SpaceShuttle"}] Volume@BoundaryDiscretizeGraphics[shuttle] (* 55.5217 *) But BoundaryDiscretizeRegion tends to fail on more complex geometries: {deimos = ExampleData[{"Geometry3D", "Deimos"}], phobos = ExampleData[{"Geometry3D", "Phobos"}]} BoundaryDiscretizeGraphics[deimos] BoundaryMeshRegion::binsect: The boundary curves self-intersect or cross each other in BoundaryMeshRegion[{{-0.473472,5.76096,0.000999842},{-0.32066,5.70981,0.233476},{-0.0747657,5.65315,0.231889},<<46>>,{-2.88191,5.74069,0.489521},<<9360>>},{{},{},{Polygon[{{1,2,3},<<49>>,<<18766>>}]}}]. >> In general, what is a good way to proceed when we need to treat an object as a solid 3D volume (not surface!) for various purposes, such as trian

differential equations - ODE solving and NDSolveValue error depending on parameters

Given the two sets of $2N$ equations Eu[n_, i_] := ((I*k)/(2*Pi))*Subscript[λu, i][t] - Sum[If[j != i, Coth[(Subscript[λu, j][t] - Subscript[λu, i][t])/2], 0], {j, 1, n}] + (1/2)*Sum[Tanh[(Subscript[λt, j][t] - Subscript[λu, i][t] - mt)/2] + Tanh[(Subscript[λt, j][t] -Subscript[λu, i][t] + mu)/2], {j, 1, n}]; Et[n_, i_] := (-((I*k)/(2*Pi)))*Subscript[λt, i][t] - Sum[If[j != i, Coth[(Subscript[λt, j][t] - Subscript[λt, i][t])/2], 0], {j, 1, n}] + (1/2)*Sum[Tanh[(Subscript[λu, j][t] - Subscript[λt, i][t] - mu)/2] + Tanh[(Subscript[λu, j][t] - Subscript[λt, i][t] + mt)/2], {j, 1, n}]; I need to solve the following system of ODE Eqs[n_] := Flatten[Table[{τu*D[Subscript[λu, i][t], t] == Eu[n, i], τt*D[Subscript[λt, i][t], t] == Et[n, i]}, {i, n}]]; with the following initial values ICs[n_] := Flatten[Table[{Subscript[λu, i][0] == 0.1*i, Subscript[λt, i][0] == 0.1*i}, {i, n}]]; The functions to determine are the following Vars[n_] := Join[Table[Subscript[λu, i], {i, n}], Table[Subscript[λt,

plotting - 1$sigma$ contour plot for a two-dimensional Gaussian

Say I have a 2D Gaussian with $$\mu=(\mu_1,\mu_2)$$ and $$ \Sigma= \left( {\begin{array}{cc} \sigma_{11}^2 & \rho \sigma_{11} \sigma_{22} \\ \rho \sigma_{11} \sigma_{22} & \sigma_{22}^2 \\ \end{array} } \right) $$ For example p = {m1 -> 1.5, m2 -> -0.5, s11 -> 0.5, s22 -> 0.5, r -> -0.2}; ContourPlot[ PDF[MultinormalDistribution[{m1, m2}, {{s11^2, r s11 s22}, {r s11 s22, s22^2}}] /. p, {x, y}], {x, 0, 3.}, {y, -2, 1}, Contours -> {0.2}, ContourShading -> None] [ Contours -> {0.2} inserted only for illustration, just to have any number to make a plot. ] How can I plot the 1$\sigma$ contour of the 2D Gaussian? It encompasses $\approx 0.39$ of the volume under the surface (being analogous to the 0.68 fraction marking the 1$\sigma$ region in the 1D Gaussian case). So, the precise questions are (a) at what height of the PDF should I place the 1$\sigma$ contour? (Note: I can extract the maximum max of the PDF and easily plot, e.g., the contour correspond

front end - Selection bugs make Mathematica 10 unusable

I'm getting odd selection bugs in Mathematica (starting in 10.0.1.0, OS X 10.10 and still present in 10.3.1.0, OS X 10.11.2) that are making it impossible to use. For example if I simply click before the 'i' in With I get while if I click after the 't' I get and if I click after the '=' in mp = I get Attempts to drag out a selection produce similarly bizzare results, with the selection extending several to many characters ahead of the dragged location, in starts and fits; while double-clicking selects huge blocks of code. This happens in fresh notebooks in fresh Mathematica sessions into which any amount of code has been pasted or typed. Obviously this makes it impossible to get anything done. Has anyone else seen this bug? Is there something I could reset or disable that might be the cause?

functions - Strange behavior with Cases and Position with SetDelayed

I feel like I must be missing something simple and obvious here, but this has me scratching my head. This works as expected: list = {f[a], f[b]}; Cases[list, f[x_] :> x] -> Position[list, f[_]] (* {a, b} -> {{1}, {2}} *) However, this does not: fun[list_] := Cases[list, f[x_] :> x] -> Position[list, f[_]]; fun[list] (* {x, x} -> {{1}, {2}} *) Is this a bug, or have I just not had enough coffee today? Answer What's happening This is not simple by any means. You have encountered another instance of a general situation with lexical scope leaks / emulation / over-protection by symbol renaming. The case at hand is pretty similar to the one discussed here , so you can read the detailed explanation of this behavior in my answer there. Roughly speaking, outer lexical scoping constructs ( RuleDelayed in the linked dicsussion, and its analog for implicit global rule application here), try to protect the inner bindings from destructive changes, but mis-interpret their pie