Skip to main content

Posts

Showing posts from September, 2016

graphics - An efficient circular arc primitive for Graphics3D

As many people have noted, the 2D graphics primitive Circle doesn't work in a Graphics3D environment (even in v10.0-v10.4, where many geometric regions were added). Several solutions to this problem have been proposed, both on this site and on StackOverflow . They all have the disadvantage that they result in either rather ugly circles or highly inefficient ones because these circles were generated using polygons with several hundreds of edges, making interactive graphics incredibly slow. Other alternatives involve the use of ParametricPlot which doesn't generate efficient graphics either or yield a primitive that can't be used with GeometricTransformation . I would like to have a more elegant solution that creates a smooth circular arc in 3D without requiring zillions of coordinates. The resulting arc should be usable in combination with Tube and can be used with GeometricTransformation . Answer In principle, Non-uniform rational B-splines (NURBS) can be used to re

calculus and analysis - Multivariable Taylor expansion does not work as expected

The basic multivariable Taylor expansion formula around a point is as follows: $$ f(\mathbf r + \mathbf a) = f(\mathbf r) + (\mathbf a \cdot \nabla )f(\mathbf r) + \frac{1}{2!}(\mathbf a \cdot \nabla)^2 f(\mathbf r) + \cdots \tag{1}$$ In Mathematica , as far as I know, there is only one function, Series that deals with Taylor expansion. And this function surprisingly doesn't expand functions in the way the above multivariable Taylor expansion formula does. What I mean is that the function Series doesn't produce a Taylor series truncated at the right order. For example, if I want to expand $f(x,y)$ around $(0,0)$ to order $2$, I think I should evaluate the following Mathematica expression: Normal[Series[f[x,y],{x,0,2},{y,0,2}]] But the result also gives order $3$ and order $4$ terms. Of course, I can write the expression in the following way to get a series truncated at order $2$: Normal[Series[f[x,y],{x,0,1},{y,0,1}]] but in this way I lose terms like $x^2$ and $y^2$, so it

import - Working with Java hashmaps from Mathematica

I'm using J/Link to access data from an external Java program. The data are represented as a ConcurrentHashMap (see the official specification here ). link = JavaNew["org.ddpclient.DDPTestClient"]; When I evaluate data = link@mCollections in my Mathematica notebook to access mCollections field where the data of interest are stored, I get a HashMap object: « JavaObject[java.util.HashMap]» Is there a way to convert this HashMap into a native Mathematica list (or nested list, to be more precise) so that I could work with it? I know that one can call a toString[] method on the HashMap object to convert it to a string. In my case, data@toString[] yields something like this: {G9fuqeYuiQpcmL8MW={playerId=zxcgf24ta, lastSeen=null, status=0.0, \ active=true}, aiej2mQppBAefhad7={playerId=lklu453da1, lastSeen=null, \ status=0.0, active=true}, Bbd8YqAx8yFcdcMcz={playerId=poo10alll235, \ lastSeen=null, status=0.0, active=true}, \ Gnt3KKrrgypgFEorp={playerId=hjffxz535cd, lastSeen=

calculus and analysis - Integrate Squared Legendre Polynomial

With the same purpose as this question, I wish to evaluate an integral that contains the squared Legendre Polynomials. $\int_{-1}^{1}\left[P_n(x)\right]^2dx=\frac{2}{2n+1}$ I tried evaluating with no success: Assuming[{ $n$$\in$ Integers,n $\geq$ 0}, $\int_{-1}^{1}$ LegendreP[n,x] $^2$ dx] Assuming[{Element[n, Integers], n >= 0}, Integrate[LegendreP[n, x]^2, {x, -1, 1}]] It seems odd that Mathematica wouldn't natively consider doing this, because Wolfram has specified the relationship on mathworld.wolfram.com - See Eqn (28) . I am not familiar with the backend processes of Mathematica, however I would expect a check to be performed when integrating with Legendre Polynomials. Why is this not the case, and is there any alternative for an algebraic solution? Edit: Example An example of where this may be used is in solving an ODE that is a Sturm-Liouville System, and is very close in relation to the Legendre DE: $([1-x^2]u')' + \mu \rho(x) u = f(x)$ Both when $\mu=\lambda_

simplifying expressions - Using Inequality Assumptions

I'm having getting Mathematica to use my inequality assumptions. Here's a simple example: $Assumptions = (v-w*x+y*z)>0 FullSimplify[Sign[(v-w*x+y*z)]] Output: Sign[v-wx+yz] (Meaning that the assumption had no effect) However, if I put in the pieces separately, it gives me the expected results. $Assumptions = (v-w*x)>0 FullSimplify[Sign[(v-w*x)]] Output: 1 $Assumptions = (y*z)>0 FullSimplify[Sign[(y*z)]] Output: 1 Answer The number of variables in the nonlinear expression in your first example ( 5 ) exceeds the limit set by the system sub-option "AssumptionsMaxNonlinearVariables" (which is 4 ). SystemOptions["SimplificationOptions"] {"SimplificationOptions" -> {"AssumptionsMaxNonlinearVariables" -> 4, "AssumptionsMaxVariables" -> 21, "AutosimplifyTrigs" -> True, "AutosimplifyTwoArgumentLog" -> True, "FiniteSumMaxTerms" -> 30, "FunctionExpandMaxSteps" -> 15,

graphics - Visualisation of the field of algebraic numbers in the complex plane

Hot to plot the field of algebraic numbers in the complex plane? In this picture, the color of a point indicates the degree of the polynomial of which it’s a root: red = rational numbers green = roots of quadratic polynomials, blue = roots of cubic polynomials yellow = roots of quartic polynomials, and so on I tried first few steps: data = Table[(-b + Sqrt[b^2 - 4 a c])/(2 a), {a, 1, 100}, {b, -100, 100}, {c, -100, 100}]; ListPlot[{Re[#], Im[#]} & /@ data, AxesOrigin -> {0, 0}, PlotStyle -> [Green, PointSize[.02]]] but it doesn't work.. Thank you in advance to any one who may be able to give me some ideas Answer Your code works fine, but it's missing half the roots, and a Flatten ing of the list of numbers prior to applying Re and Im helps. Adding those in: data = Flatten[ Table[{(-b + Sqrt[b^2 - 4 a c])/(2 a), (-b - Sqrt[b^2 - 4 a c])/(2 a)}, {a, 1, 20}, {b, -20, 20}, {c, -20, 20}]]; ListPlot[{Re[#], Im[#]} & /@ data, PlotRange -> {{-3, 3}

differential equations - DSolve and coupled linear first order PDEs

Does any one know a trick to make DSolve find solution to this coupled linear first order PDE system: (these are Cauchy-Riemann PDE equations, but with one of them having one of the dependent variables as well). ClearAll[F1,F2,x,y]; ode1 = D[F1[x,y],y]-D[F2[x,y],x] == 0 ode2 = D[F1[x,y],x]+D[F2[x,y],y] == y (*y here causes the problem*) DSolve[{ode1,ode2},{F1[x,y],F2[x,y]},{x,y}] This can be solved in Maple: restart; #infolevel[pdsolve]:=3; eq1:= diff(F1(x,y),y)-diff(F2(x,y),x) = 0; eq2:= diff(F1(x,y),x)+diff(F2(x,y),y) = y; pdsolve({eq1,eq2},{F1(x,y),F2(x,y)}); Solution it gives is F1(x, y) = _F1(y-I*x)+_F2(y+I*x) F2(x, y) = I*_F1(y-I*x)-I*_F2(y+I*x)+(1/2)*y^2+_C1 Screen shot: If the RHS of the second equation is not y but a constant or some other parameter, then Mathematica can now solve it: ClearAll[F1,F2,x,y,m]; ode1 = D[F1[x,y],y]-D[F2[x,y],x] == 0 ode2 = D[F1[x,y],x]+D[F2[x,y],y] == m DSolve[{ode1,ode2},{F1[x,y],F2[x,y]},{x,y}] Is this a known limitation of DSolve or

plotting - Axes labels as multiples of $pi$

I have a list as containing seven elements: list={0, Cos[t/4] + Cos[(3 t)/4] + I (Sin[t/4] - Sin[(3t)/4]), 0, -Cos[t/4] - Cos[(3 t)/4] + I (Sin[t/4] + Sin[(3t)/4]), 0, +Cos[5t/4] - Cos[(3 t)/4] + I (Sin[5t/4] + Sin[(3t)/4]), Cos[5t/4] - Cos[(3 t)/4] + I (Sin[5t/4] - Sin[(3t)/4]) } I want to plot Abs[list[[2]]*list[[4]]], Abs[list[[2]]*list[[6]]], Abs[list[[2]]*list[[7]]] from {t,0,8 pi} just in one plot. I used Plot[{Abs[list2[[2]]*list2[[3]]], Abs[list2[[2]]*list2[[5]]], Abs[list2[[2]]*list2[[9]]]}, {t, 0, 8 π} ] but the problem is: my favorite situation is scaling the 'x' axes with multiple of pi, for example: pi/6, pi/4, pi/3, pi/2, 5pi/6, 3pi/4, 2pi/3, pi and ... 8 pi. However, they are not in the similar interval (Pi/6-0 != pi/4-pi/6) and I want to show them with the symbol of pi ( Esc pi Esc ) on the x axes. Has anyone had an experience with this? Answer Try this: list = {0, Cos[t/4] + Cos[(3 t)/4] + I (Sin[t/4] - Si

programming - How to correct my code for solving the Josephus problem?

Problem Description Recently, I have been reading the book Schaum's Outline of Mathematica (2nd Edition) , where I encountered the problem: Flavius Josephus was a Jewish historian of the first century. He wrote about a group of ten Jews in a cave who, rather than surrender to the Romans, chose to commit suicide, one by one. They formed a circle and every other one was killed. Who was the lone survivor? The author's solution: list = Range[10]; While[Length[list] > 1, list = Rest[RotateLeft[list]]]; list {5} However, I know it is not efficient to use the procedural methods such as Do , While , etc. Rather, I want to use a functional method like NestWhile , Nest , or FixedPoint to solve the problem. My solutions: Method 1: list = Range @ 10; NestList[Rest @ RotateLeft[#] &, list, 9] {{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}, {3, 4, 5, 6, 7, 8, 9, 10, 1}, {5, 6, 7, 8, 9, 10, 1, 3}, {7, 8, 9, 10, 1, 3, 5}, {9, 10, 1, 3, 5, 7}, {1, 3, 5, 7, 9}, {5, 7, 9, 1}, {9, 1, 5},

plotting - Listplot imaginary part of complex numbers

I have the following list w={{0.01,99 +0.00001414 I},{0.15,6.6370108 +0.003144129 I},{0.25,3.9515722 +0.00854493297 I},{6,0.10041 +0.28132187 I}} and I want to ListPlot the imaginary part but with the command Im[w] I get the list {{0,0.00001414},{0,0.00314413},{0,0.00854493},{0,0.281322}} This way I basically lose the x axis values 0.01, 0.15, 0.25 and 6. How can I get in a list the imaginary part and the x axis values? (With Re[w] I can get the real part right, the 0.01, 0.15 etc don't change) Answer Almost a dozen alternatives with timings: ClearAll[f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11]; f1[w_] := w /. {a_, Complex[_, b_]} :> {a, b}; f2[w_] := {#, Im@#2} & @@@ w; (* my favorite ... credit: ubpdqn *) f3[w_] := w /. Complex[_, b_] :> b; f4[w_] := MapAt[Im, w, {{All, -1}}]; f5[w_] := Module[{s = Im /@ w}, s[[All, 1]] = w[[All, 1]]; s]; f6[w_] := Module[{s = w}, s[[All, -1]] = Im /@ w[[All, -1]]; s]; f7[w_] := Transpose@{First /@ w, Im /@ Last /@ w}; f8[w_] :=

number theory - Generating a list of all factorizations

What is the best way to generate a list of all factorizations of some number $n$? I'm quite new to Mathematica so this might be obvious. I have been trying some basic stuff with For -loops and FactorInteger and Divisors but I'm not really getting anywhere. There must be some elegant way of doing this. An example of the result I'm after, for $n=60$: $$\{\{2,2,3,5\}, \{4,3,5\}, \{2,6,5\}, \{2,3,10\}, \{2,2,15\}, \{12,5\}, \{2,30\}, \{3,20\}, \{4,15\}, \{6,10\}, \{60\}\}.$$ Answer A function from the article that cormullion linked is shorter and faster than what I proposed below. Transcribed in terse style: uf[m_, 1] := {{}} uf[1, n_] := {{}} uf[m_, n_?PrimeQ] := If[m < n, {}, {{n}}] uf[m_, n_] := uf[m, n] = Join @@ Table[Prepend[#, d] & /@ uf[d, n/d], {d, Select[Rest@Divisors@n, # <= m &]}] uf[n_] := uf[n, n] uf[60] {{5, 3, 2, 2}, {5, 4, 3}, {6, 5, 2}, {10, 3, 2}, {10, 6}, {12, 5}, {15, 2, 2}, {15, 4}, {20, 3}, {30, 2}, {60}} I propose this: ClearAll[f, f

list manipulation - Why does Thread FileDate give an error message?

I tried for example Thread[FileDate[FileNames["new*", "h:\\temp\\", 1]]] It gives FileDate::fstr: File specification {h:\temp\NEWEA7D.tmp,h:\temp\NEWEA7E.tmp,h:\temp\NEWEAAE.tmp} is not a string of one or more characters. >> but still gives the right answer Out[13]= {{2013, 11, 18, 23, 14, 32.}, {2013, 11, 18, 23, 14, 32.}, {2013, 11, 18, 23, 14, 32.}} Why is there a error message? How to avoid it? Answer This is a consequence of the semantics of Thread , which does not hold its arguments. This issue has been discussed many times in various Mathematica - related resources. For the case at hand, and also generally, there are several ways to avoid this issue. The simplest solution would be to just avoid Thread here and use Map instead: Map[FileDate, FileNames["*.nb", {"~/Documents"}, 1]] If you insist on using Thread , then, basically, we want to prevent FileDate from evaluating before it gets appropriately threaded. In this case, this

packages - Plotting ErrorBars with a different style

I would like to plot the error bars of ErrorListPlot with a different style than the points. I know of ErrorBarFunction , but then I have to recreate the automatic ErrorBarFunction ... Here is my current butt ugly hack (I draw the plot twice): data = Table[{x, f[x], RandomReal[]}, {f, {Exp[2 #] &, Exp}}, {x, -5, 2, 0.2}]; Needs["ErrorBarPlots`"] Show@{ErrorListPlot[data, PlotStyle -> Directive[Thick, PointSize -> 0., Opacity@0.5], ImageSize -> Large], ListPlot[data[[All, All, {1, 2}]], PlotStyle -> Directive[Thick, PointSize -> 0.015], ImageSize -> Large] } What is a more elegant way of doing this? Something like: ErrorListPlot[data, PlotStyle -> Directive[Thick, PointSize -> 0., Opacity@0.5], ImageSize -> Large, ErrorBarFunction -> {Opacity@0.5,Automatic}] Answer You can use the sub-option "LineOpacity" in PlotStyle : ErrorListPlot[data, PlotStyle -> Directive[Thick, PointSize[Large], &qu

graphics - Consistent Plot Styles across multiple MMA files and data sets

I am starting to write a thesis for which I want to use MMA for all my plotting needs, mostly because a lot of the basic analysis has been done there. To ensure that I am applying styles consistently (plot colors, image size, label size, etc.), I need a method which I can use across multiple files. There are several types of plots that I will need: ListPlot / Plot ListDensityPlot / DensityPlot ListContourPlot / ContourPlot I can think of several way of doing this: Define my own functions thPlot , thListPlot , etc which have my default styles applied Define my own style options into a variable, and use some combination of FilterRules and Options to make sure that options from that variable are applied to the right type of plot Set default options using Default for the different types of plots. I am assuming that each of my datasets (which may have one or more plots) will be self-contained mathematica files that I can re-run. So, if I decide to change the style in some central loca

equation solving - How do I get all possible solutions in an underdetermined system?

I have two problems which I'd like to solve with Mathematica . If I have a system of two equations with three unknowns, how can I get to list all possible solutions for the unknowns? Here is what I have tried: Solve[{ a + b + c == 5, 1/a + 1/b + 1/c == 1/5}, { a, b, c}] Solve::svars: Equations may not give solutions for all "solve" variables. >> {{a -> 5, c -> -b}, {b -> 5, c -> -a}, {b -> -a, c -> 5}} What would I change in this specific instance? Here are the problems: I Suppose that $a, b, c$ are real numbers satisfying $a+b+c=5$ and $\frac{1}{a}+\frac{1}{b}+\frac{1}{c}=+\frac{1}{5}$. Find the greatest possible value of $a^3+b^3+c^3$ If I list all solutions I'll be able to choose all solutions maximizing $a^3+b^3+c^3$. II Finding integers $x, y$ and $z$ that satisfy this system: $$\quad x^2 y + y^2 z + z^2 x = 2186 $$ $$\quad x y^2 + y z^2 + z x^2 = 2188$$. evaluate $x^2+y^2+z^2$ The both problems can be found here (see exercises $27$ and $

plotting - How I can make the StreamPlot of this differential equation?

I need the StreamPlot of this differential equation but I don't know how. dp/dt = 0.4 p(1 - p/30), 0 <= t < 5 and 0.4 p (1 - p/30) - 0.25 p, t > 5

plotting - Difference between two Listplots

this is a simple question, and excuse me if it's already been answered; I searched around and couldn't find anything. I have two listplots, both along the same number of x data points, but with different y values. I want to find the difference between the two y values, while keeping the x values the same. I tried just subtracting the two, but that leaves all the x values as equal to 0, which is undesirable, of course.

Mathematica memory management for large arrays

I have come across a weird phenomenon in Mathematica when dealing with large arrays. When generating a list with all the possible subsets of three elements of another list (thus having elements which are lists of 3 elements), I have observed that if you extract these elements in three separate arrays, Mathematica uses much less memory to store the data, even if the total number of elements we have is exactly the same. My question is surely naive: why does this happen? This is a minimal code that sets an example of what I'm saying, recording the memory used by Mathematica in every step: n = 100; memvec = {MemoryInUse[]}; timesubset = Subsets[Range[1, n], {3}]; AppendTo[memvec, MemoryInUse[]]; (*Extract all the first elements*) t0 = timesubset[[All, 1]]; AppendTo[memvec, MemoryInUse[]]; (*Extract all the second elements*) t1 = timesubset[[All, 2]]; AppendTo[memvec, MemoryInUse[]]; (*Extract all the third elements*) t2 = timesubset[[All, 3]]; AppendTo[memvec, MemoryInUse[]]; Clear[tim

calculus and analysis - How to convert a system of parametric equations to a normal equation?

For example, I have a system of parametric equations ( R is a constant number) : { x == p + R Cos[k], y == Cos[p] + R Sin[k], k == ArcTan[ 1/Sin[p] ] } Now I am going to find the normal equation of $\; y = f(x)\;$ without other variables. (Theoretically it is possible because there are totally 4 variables and 3 equations.) How can I do this in Mathematica? Answer First, for the sake of simplicity let's define eqs - the system of our interest : eqs = { x == p + R Cos[k], y == Cos[p] + R Sin[k], k == ArcTan[ 1/Sin[p]] }; Equations y = y(x) For this system we can find an explicit equation $\;y = y(x)\;$ only assuming R == 0 , otherwise we could find only implicit solutions. Solve[ eqs /. R -> 0, y, {p}, MaxExtraConditions -> All] {{y -> ConditionalExpression[Cos[x], k == ArcTan[Csc[x]]]}} See e.g. Inverse function theorem for the general issue of invertibility, let's restrict to : eqs[[1]] /. (Rule @@@ eqs)[[3]] x == p + R/Sqrt[1 + Csc[p]^2]

How to solve numerically an equation which contains numerical integration?

F1[x_] := NIntegrate[E^Sin[y x], {y, 0, 1}] F2[x_] := Log[x] NSolve[F1[x] == F2[x], x] I want to solve the equation, but Mathematica don't solve it. What I should do? Answer This can be solved via a numerical method called fixed point iteration reasonably quickly... FixedPoint[F1[#] - F2[#] + # &, 2, 100] (* result 4.609527035642726` takes about 0.327602 seconds on my machine *)

differential equations - Eigenvalue dependent boundary conditions- mathematica

I am dealing with an eigenvalue problem whose boundary conditions are also eigenvalue dependent. Could anyone please comment whether Mathematica can numerically solve such a problem? For boundary condition independent of eigenvalues, I use NDEigenSystem . A minimal working example is given here. The eigenvalue problem: $$ -\frac{d^2 \psi}{dx^2} +x^2 \psi = E \psi $$ with two boundary conditions: $$\textrm{(i) }\psi = 0 \textrm{ at }x = 0$$ and $$\textrm{(ii) }\frac{d\psi}{dx}+E^2\psi = 0 \textrm{ at } x = 1$$ needs to be solved to calculate the eigenvalues, $E$ , of this operator. This might seem to be a trivial task, but please be aware of the eigenvalue-dependent boundary condition. I would be very thankful if anybody could suggest how to solve such eigenvalue problem in mathematica.

Any ergonomic tools for the command line kernel?

Mathematica on the command-line (invoked by running 'wolfram' on bash shell) seems bereft of all modern usability features. I'd like a list of the best third-party packages available (if any exist) for command line work. At a bare minimum, I'm looking for a way get a textual Monitor or ProgressIndicator to inspect non-instantaneous computation: n = 1; Monitor[While[True, n++], n] This trick from python of years ago might help: using the carriage return ('\r') character to return to the start of the line without advancing to the next line to achieve "dynamic" updates in the shell prompt: for x in range(10): print '{0}\r'.format(x), print Perhaps something similar for Mathematica is possible? Details: I'm using Ubuntu 18 Linux MMA 11.3 I'd like to see an exhaustive list of symbols that require front end In Python (or iPython) there are many ergonomic tools for the command line REPL like auto-completion or textual progress bars ( tqm

plotting - ArrayPlot with cells labeled by corresponding values

I would like to have ArrayPlot[] also present the value of each cell in it, similar to the LabelingFunction that is available in other types of plots. How do I do it? Answer Like this? SeedRandom[42, Method -> "Legacy"]; (* for reproducibility *) mat = RandomReal[1, {3, 5}]; ArrayPlot[mat, Epilog -> {Red, MapIndexed[Text[#1, Reverse[#2 - 1/2]] &, Reverse[mat], {2}]}, Mesh -> True]

image processing - Download xkcd Click and Drag comic

Inspired by the recent question about xkcd styled plots I started looking at xkcd again and I came across a comic titled Click and Drag . And if you do that, you start exploring a larger drawing. A much larger drawing. How large? I don't know, but I spent about half and hour exploring it before my arm wore out. Now I want to see all the comic but I don't want to give myself RSI in the process. That leads me, finally, to my questions: How can I use Mathematica to download the entire scrollable drawing? How can it be assembled and stored? This will surely be a tremendously large image; what data formats does Mathematica support that can handle it? Is it possible to navigate the image from within Mathematica ? In fairness people may ask "what have you tried" and I must say: nothing. Not long after posting I realized that the tiles are stored as PNG files with names that describe the location. This was also mentioned in the comments. This makes acquisition easier tha

numerics - Solving underdetermined Lyapunov equations?

I'm wondering if there's an efficient way to get a solution (ie, LeastSquares solution) for Lyapunov equation $AX+XA=C$ with symmetric positive definite $ A $ and $ C $ . I want something that would work like LyapunovSolve , but would work for underconstrained problems, i.e., LyapunovSolve[A, A] should give me something whose spectrum looks like $ I $ . I tried a naive approach which is to do Kronecker expansion followed by LeastSquares , which gives the desired result kronExpand[x_] := Module[{ii}, ii = IdentityMatrix[First[Dimensions[x]]]; ii\[TensorProduct]x + Transpose[x]\[TensorProduct]ii ]; lyapLeastSquares[A_, B_] := Module[{d, X}, X = LeastSquares[kronExpand[A], vec[B]]; X = unvec[X, d]; (check this notebook for an end-to-end example) However, this expansion is too large to be practical. IE, my matrices are on the order of 1000 which is fast using LyapunovSolve , but doing Kronecker expansion means that I have matrices on the order of 1M-by-1M. Any sugg

plotting - 3D heatmap density plot

I have a set of data that looks like {{x1, y1, z1}, {x2, y2, z2}, ...} so it describes points in 3D space. I want to make a heatmap out of this data. So that points with a high density are shown as a cloud and marked with different colors dependend of the density. In fact, I want the result of this script just for 3D: data = RandomReal[1, {100, 2}]; SmoothDensityHistogram[data, 0.02, "PDF", ColorFunction -> "Rainbow", Mesh -> 0] Answer If you want to plot a distribution that is three dimensional then first you need to form it! SmoothDensityHistogram plots a smooth kernel histogram of the values $\{x_i,y_i\}$ but as we have three dimensional data here we need the function called SmoothKernelDistribution ! data = RandomReal[1, {1000, 3}]; dist = SmoothKernelDistribution[data]; Now you have got the probability distribution with three variables. So we can simply plot the PDF as a 3d contour plot using ContourPlot3D . Keep in mind that this function is reputed

output formatting - Continuous background color of adjacent cells

I'm trying to make continuous blocks of cells so that their background colors are the same, but without breaks of white space between them. E.g. After some recent digging, I found the option "Show Expression", which converts the cell to its explicit contents that Mathematica can interpret. For example, the third cell in the image can be created by writing CellPrint[ Cell["Can we make all", "Text", Background->RGBColor[0.87,0.94,1] ] ] Showing the expression gives more information than I need, which I've omitted in this example. (Things like CellChangeTimes and expression for symbols like the apostrophes. There was also an option specifying the grouping.) I'm wondering if there's a simple way to use this code to my advantage so I can format the cells so that the line break between stays the same color. I realize that with text, I can just start a new paragraph by hitting Return a few times, but I'm tryi

export - Which ray-tracing software is compatible with Graphics3D?

I am interested in working alternative to Mathematica 's FrontEnd for rendering Graphics3D produced by Mathematica . The requrements are: An ability to import Graphics3D objects exported from Mathematica in any of 3D export formats supported by Mathematica . It seems that in most cases Mathematica 's support of 3-rd party 3D geometry formats is incomplete ( Mathematica does not export the complete scene description). So the second requirement is that recovering of dropped parts of the scene description would be as easy as possible. I am most interested in rendering polygonal surfaces computed by Mathematica which are presented internally as GraphicsComplex . It will be very appreciated if an answerer show the complete way to render some simple Mathematica -generated surface with several point light sources like this: lightSources = {{"Point", Red, {1/2, 1, 1}}, {"Point", Green, {1, 1/2, 1}}, {"Point", Blue, {0,

Simplify expression to Abs

FullSimplify[Sqrt[1/(a^2 b^2)], Element[{a, b}, Reals]] gives Abs[1/(a b)] How do I simplify the following expression FullSimplify[Sqrt[(1 + a + b)/(a^2 b^2)], Element[{a, b}, Reals]] into $\frac{\sqrt{a+b+1}}{\left| a b\right| }$ ? Answer While LeafCount is not the complete ComplexityFunction used by Simplify it is a good first order approximation, and you can see that your expressions are equivalent under this metric: expr1 = Sqrt[(1 + a + b)/(a^2 b^2)]; expr2 = Sqrt[a + b + 1]/Abs[a b]; LeafCount /@ {expr1, expr2} {15, 15} In your particular case merely using StringLength works: FullSimplify[expr1, {a, b} \[Element] Reals, ComplexityFunction -> (StringLength @ ToString @ # &)] Sqrt[1 + a + b]/Abs[a b]

plotting - How can I plot this transcedental equation?

How can I plot $\kappa(\epsilon_{dd},\lambda)$ this transcendental equation? $$3\kappa^2 \epsilon_{dd}\left[\left(\frac{\lambda^2}{2}+1\right)\frac{f_s(\kappa)}{1-\kappa^2}-1\right]+(\epsilon_{dd}-1)(\kappa^2-\lambda^2)=0 $$ where $\lambda=1,2,3,4$ and $$f_s(\kappa)=\frac{1+2\kappa^2}{1-\kappa^2}-\frac{3\kappa^2 artanh \sqrt{1-\kappa^2} }{(1-\kappa^2)^{3/2}}. $$ My original problem is not that, but it's similar. If you help me with this, maybe I can solve mine. Here are the codes of equations: fs[kappa_] := (1 +2 kappa^2)/(1 - kappa^2) - (3 kappa^2 ArcTanh[ Sqrt[1 - kappa^2]])/(1 - kappa^2)^(3/2) 3 kappa^2 edd (((lambda^2/2) -1 ) fs[kappa]/(1 - kappa^2) - 1) + (edd - 1) (kappa^2 - lambda^2) == 0 Answer Use ContourPlot . fs[kappa_] := (1 + 2 kappa^2)/(1 - kappa^2) - (3 kappa^2 ArcTanh[Sqrt[1 - kappa^2]])/(1 - kappa^2)^(3/2) zero[kappa_, edd_, lambda_] = 3 kappa edd (((lambda^2/2) + 1) fs[kappa]/(1 - kappa^2) - 1) + (edd - 1) (kappa^2 - lambda^2); Show[{ContourPlot[ Evaluat

Plotting piecewise functions with distinct colors - issue found

I've been making use of the following thread: Plotting piecewise function with distinct colors in each section A handy feature I found there goes as follows: Module[{i = 1}, Plot[pw, {x, -2, 2}, PlotStyle -> Thick] /. x_Line :> {ColorData[1][i++], x} ] pw is some piecewise function, and this code makes every region defined in pw to have a different color in the plot. However, this only seems to work when Plot "detects" a discontinuity in the line object it is drawing. I know this because specifying Exclusions->None leaves only 1 color, and changing PlotPoints also affects coloring. I suppose I could abandon that method and try the other ones in the thread I linked, but the syntax they use is beyond my current knowledge. Although that's something I can overcome, those other methods also seem like too much work for something that I feel should be simple to implement. Basically, I'm looking for the best way to do this piecewise coloring in Plot wit

equation solving - Help needed to make NIntegrate Converge

I have the following notebook (trying to caclulate the pull-in voltage of a structure): phi1 = b1 Cos[1.03855 x1] - b1 Cosh[1.03855 x1] + a1 Sin[1.03855 x1] - a1 Sinh[1.03855 x1] phi2 = b2 Cos[1.84683 x2] + d2 Cosh[1.84683 x2] param = {b1 -> -0.255808, b2 -> 0.0340514, d2 -> 0.00305984, a1 -> 1, c1 -> -1} (*Numeric Constants*) h = 2*10^-6; wa = 10*10^-6; la = 60*10^-6; w = 100*10^-6; l = 100*10^-6; g = 1*10^-6; e = 160*10^9; epsilon0 = 8.85*10^-12; sig0 = 0 i1 = wa*h^3/12; i2 = w*h^3/12; Area1 = h*wa; Area2 = h*w; θ = (Area2/Area1)^(1/4); α = (i2/i1)^(1/4); u = la/(l + la); y = l/(l + la); numericPhi1[x1_] = phi1 /. param numericPhi2[x2_] = phi2 /. param ph[x_] = Piecewise[{{numericPhi1[x], 0 <= x <= u}, {numericPhi2[1 - x], u < x <= 1}}]; ϕ[x_] := Piecewise[{{ph[x], 0 <= x <= 1}, {ph[2 - x], 1 < x <= 2}}]; b[x_?NumericQ] := Piecewise[{{wa, 0 <= x <= u}, {w, u < x <= 1}, {w, 1 < x <= 1 + (1 - u)}, {wa, 1 + (1 - u