Hot answers tagged

22

This is probably too slow to get a decent image, but here's a simple attempt. As JM suggests, you can use Geodesate to get a good set of points on the sphere. I used ContourPlot3D to plot a sphere whose radius increases in the vicinity of one of those points. Needs["PolyhedronOperations`"] pts = Geodesate[PolyhedronData["Icosahedron"], 2][[1, 1, 14 ;;]]; ...


12

A mathematical approach using $A_\text{g}$ irreps of $I_h$ symmetry group expressed in terms of spherical harmonics. First some data l[1] = 6; mlist[1] = {-5, 0, 5}; slist[1] = {Sqrt[7]/5, Sqrt[11]/5, -(Sqrt[7]/5)}; l[2] = 10; mlist[2] = {-10, -5, 0, 5, 10}; slist[2] = {Sqrt[187/3]/25, -(Sqrt[209]/25), Sqrt[247/3]/25, Sqrt[ 209]/25, Sqrt[187/3]/25}; l[...


8

First you should note that you copied the function down incorrectly. It should be f[x_, y_] := (y - 3 - Abs[x - 3])^2 ((x - 3)^2 + (y - 3 + Sqrt[y^2 - 6 y + 9])^2)^2 ((x - 6)^2 + (y - 3)^2 - 1)^2 + (y^2 - 6 y + 8 + Sqrt[y^4 - 12 y^3 + 52 y^2 - 96 y + 64])^2 The function does not cross zero at the position of the lines, it only touches. For example ...


7

You are looking for TransformedRegion. GeometricTransformation is for transforming graphics primitives, but you are looking at region functionality. This is a case where the difference is important. Simply, t = TransformedRegion[p, AffineTransform@A] (* Parallelogram[{0, 0}, {{-1, 2}, {3, 0}}] *) where the AffineTransform was needed as TransformedRegion ...


6

This would reproduce the picture you show in the question: With[{off = 30}, Do[ CreateDocument[{Plot[Sin[i x], {x, 0, Pi}]}, WindowSize -> {300, 200}, WindowOpacity -> .7, WindowMargins -> {{100 + off i, Automatic}, {Automatic, 10 + off i}}], {i, 1, 10}]] I added opacity as per the comment.


6

An alternative way of getting a similar display would be to define a new function leftFramed that only puts a vertical extensible line to the left of the content: leftFrame /: MakeBoxes[leftFrame[obj_], _] := RowBox[{"\[LeftBracketingBar]", ToBoxes[obj]}] Framed[x -> leftFrame[ Column[{"Depression", "PTSD", "Diabetes Type II", "Smoker"}]]] ...


6

Would a CellFrame around a TextCell work? Framed[ x -> TextCell[ Column[{"Depression", "PTSD", "Diabetes Type II", "Smoker"}], "Text", CellFrame -> {{True, False}, {False, False}}]]


5

The same behaviour is observed in Mathematica 10.4.1 under Windows 10. A fix for the frame ticks is to use the option FrameTicksStyle -> Background -> None


4

Tricks to my mind,Suppose your version is 10.2 or later,although I don't sure you will like Show[SliceContourPlot3D[#, "CenterPlanes", {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, ContourShading -> White] & /@ {x, y, z}, Axes -> True, Boxed -> False, AxesOrigin -> {0, 0, 0}]


4

Well, maybe you can make something with this? a1 := SliceContourPlot3D[z, x == 0, {x, -5, 5}, {y, -5, 5}, {z, -5, 5}, Background -> Black, ContourShading -> White, Contours -> 9, TicksStyle -> {Red, Green, Blue}] a2 := SliceContourPlot3D[z, y == 0, {x, -5, 5}, {y, -5, 5}, {z, -5, 5}, ContourShading -> White, Contours -> 9] ...


4

Okay, so you have a set of Regions that you want to fill, but you can only define those regions by a set of points distributed within them. Let's make some data that reproduces this. Here are three non-overlapping regions that fill up a square: region1 = Disk[{0, 0}, 1, {0, π/2}]; region2 = RegionDifference[Rectangle[], region1]; region3 = Disk[{0, 0}, 1, ...


4

See PlotRange hh = 3; ll = 10; Animate[Graphics[{Thick, Blue, Line[{{0, 0}, {0, hh}}] , Thick, Green , Line[{{xr, 0} , {xr - (ll*xr)/Sqrt[xr^2 + hh^2], (ll*hh)/Sqrt[xr^2 + hh^2]}}]} , Axes -> True , PlotRange -> {{-4, 10}, {0, 4}}] , {xr, 3, Sqrt[ll^2 - hh^2]}]


3

test = points[70]; With somewhat equally spaced points on the sphere from this answer. Graphics3D[{Sphere[], test /. r : {x_, y_, z_} :> Cone[{.95 r, 1.25 r}, .1]}, ImageSize -> Medium, Boxed -> False]


3

In V.10.4.1, ListPlot works as expected when given the OP's data. i = Table[Labeled[{Re[5 Exp[I 5/2 t]], Im[5 Exp[I 5/2 t]]}, t, {Right}], {t, 0, 6}]; ListPlot[i] So what the OP experienced appears to be a bug that has been fixed.


2

Really just to amplify Simon Woods excellent answer: transforming $f(x,y)$ to a more manageable range (here with log): Plot3D[Log[1 + f[x, y]], {x, 1, 8}, {y, 1.5, 5}, PlotPoints -> 50, MaxRecursion -> 5, MeshFunctions -> {#3 &}, Mesh -> {{0.0005}}, MeshStyle -> {Red, Thickness[0.03]}, Background -> Black, Axes -> False, Boxed ...


2

I'll give you an example. If you are new to Mathematica, there will be many things to look up. Just select a symbol name and hit F1 (or Command-Shift-F) to look it up in the documentation. Once you understand it, you will be able to edit it to fit your needs. points = RandomInteger[{-5, 5}, {10, 2}]; ListPlot[ Labeled[#, StringForm["(``,``)", #[[1]], #[...


2

Generally, you can suppress the tooltip-on-formatting-error by setting "FormattingErrorTooltips" (or other related options) to False in the given notebook, or in the front-end: SetOptions[EvaluationNotebook[], AutoStyleOptions -> { "FormattingErrorStyle" -> {FontColor -> RGBColor[1., 0.33, 0.33], Background -> RGBColor[1., 0.33,...



Only top voted, non community-wiki answers of a minimum length are eligible