Tag Info

Hot answers tagged

340

I have to confess that I see this as a proper challenge, as I am usually quite creative in finding/combining functions to provide a desired behavior. So I will give it another try. which is generated using box[x_, x1_, x2_, a_, b_] := Tanh[a (x - x1)] + Tanh[-b (x - x2)]; ex[z_, z0_, s_] := Exp[-(z - z0)^2/s] and r[z_, x_] := (*body*).4 (1.0 - .4 ...


188

This might get me suspended from the site butt I cannot resist. The shape you are looking for can probably be approximated (depending how anal you want to be about the outcome) by two assymetric probability distributions. The obvious choices would be a Poasson or a log normal distribution. I will use the latter as it is continuous. Now the bummer is that ...


91

Parametric Buttocks Manipulator Manipulate[ ParametricPlot3D[{ (e u^p + (1 + (c - a u) (u - 1)) Cos[t]^2) Sin[t], (e u^p + (1 + (d - b u) (u - 1)) Cos[t]^2) Cos[t], 2 u}, {t, -0.2, Pi + 0.2}, {u, 0, 1.1}, Lighting -> "Neutral", Mesh -> None, PlotStyle -> Directive[Specularity[0], RGBColor[0.92, 0.85, 0.73]], Axes -> False], {{a, ...


39

Basic method There appears to be a mechanism for doing just that, though I have yet to map its capabilities. As a basic example for the time being: Themes`AddThemeRules["wizard", DefaultPlotStyle -> Thread@Directive[{Purple, Orange, Hue[0.6]}, Thick], LabelStyle -> 18, AxesStyle -> White, TicksStyle -> LightGray, Background -> ...


30

Manipulate[ ParametricPlot[({Sin[n t1], Sin[(n - 1) t1]}), {t1, 0, 2 Pi}, Epilog -> {Red, PointSize[Large], Table[If[OddQ[i + j], Point[{Cos[Pi i/(2 (n - 1))], Cos[Pi j/(2 (n))]}]], {i, 2 n - 3}, {j, 2 n - 1}]}], {{n, 5}, 2, 20, 1}] General Case I We can generalize to the Lissajous curve specified by the two non-negative ...


29

The triangle plot markers It is natural to expect that the triangle marker is placed in such a way that its center of mass (center of circumcircle) coincides with the point it marks. That's how it is implemented in all major scientific plotting software, for example Origin: Some time ago I published my own implementation of triangle-based plot markers. ...


29

Well, an unusual question to answer, what about something like this Plot3D[.7*(1 + Tanh[1 - (2*Y^2 + X^2 + X^4)]) - .3*Exp[-X^2/.0025]* Exp[-(Y - .1)^2/.15] - .2*(Exp[-(X - .7)^2/.02]*Exp[-(Y - .0)^2/.08] + Exp[-(X + .7)^2/.02]*Exp[-(Y - .0)^2/.08]), {X, -1, 1}, {Y, -1, 1}]


28

The colors alone are indexed color scheme #97: ColorData[97, "ColorList"] Update: further digging in reveals these PlotTheme indexed color relationships: {"Default" -> 97, "Earth" -> 98, "Garnet" -> 99, "Opal" -> 100, "Sapphire" -> 101, "Steel" -> 102, "Sunrise" -> 103, "Textbook" -> 104, ...


25

First define the Morse code (from rosettacode.org with corrections by @evanb) morsecode = (#1 -> Characters[#2]) & @@@ { {"a", ".-"}, {"b", "-..."}, {"c", "-.-."}, {"d", "-.."}, {"e", "."}, {"f", "..-."}, {"g", "--."}, {"h", "...."}, {"i", ".."}, {"j", ".---"}, {"k", "-.-"}, {"l", ".-.."}, {"m", "--"}, {"n", "-."}, {"o", "---"}, ...


25

Some function definitions first. AkimaInterpolation[] stolen from here (Thanks JM, wherever you are!): AkimaInterpolation[data_] := Module[{dy}, dy = #2/#1 & @@@ Differences[data]; Interpolation[Transpose[{List /@ data[[All, 1]], data[[All, -1]], With[{wp = Abs[#4 - #3], wm = Abs[#2 - #1]}, If[wp + wm == 0, (#2 + #3)/2, (wp #2 + wm ...


23

Here is another approach. It could be improved (I am sure) to properly determined the principle axes and translation (if I get time I will aim to update): lin = {#1^2, #1, #2, 2 #1 #2, #2^2} & @@@ points; lm = LinearModelFit[lin, {1, a, b, c, d}, {a, b, c, d}] Exploring model: lm["ParameterTable"] Determining quadric formula: pa = ...


22

Taking the cube root on both sides fixes the problem, and then you don't need lots of PlotPoints any more. ContourPlot3D[(x^2 + 9/4 y^2 + z^2 - 1) == CubeRoot[x^2 z^3 + 9/80 y^2 z^3], {x, -6/5, 6/5}, {y, -6/5, 6/5}, {z, -6/5, 3/2}, Mesh -> None, Boxed -> False, AxesLabel -> {"x", "y", "z"}, Axes -> False, ContourStyle -> Directive[Red, ...


21

maybe this will provide a little insight: first look at the evaluation points used by ContourPlot: f[x_?NumericQ, y_?NumericQ] := (Sow[{x, y}]; Sin[3.2 x]*Sin[1.3*y] - 2.1*Sin[1.3*x]*Sin[3.2*y]); {plot, dat} = Reap[ContourPlot[f[x, y] == 0, {x, 0, 2}, {y, 0, 2}, PlotPoints -> 50, ContourStyle -> Red]]; Row[{ ...


20

Your comment raises interesting question: I got everything simply faded and flat, while in the example - its all bright and sharp I think the problem is related to the fact that Mathematica's graphical functions always work in linear colorspace. Starting from Pickett's solution with better resampling method, in version 10.0.1 we obtain: ...


19

I wrote the ColorBar package exactly for this purpose and it makes such modifications easy. The README.m should give you all the instructions you need, but I'll summarize it here. After installing the package (copy ColorBar.m to FileNameJoin[{$UserBaseDirectory, "Applications"}]), do the following: ColorBar["TemperatureMap"] Now you can click on the ...


19

If you are comfortable using undocumented and unsupported functionality we can do this with a ScalingFunctions option as I did for ListLogLinearPlot for the whole real numbers. (* listability *) (self : fn[off_, scale_])[x_List] := self /@ x (self : invfn[off_, scale_])[x_List] := self /@ x fn[off_, scale_][x_?NumericQ] := If[x < off, Log[x], ...


18

You can make plots sort of like this: Or this: Or this: ...by taking advantage of Image and Fourier using the following code. The plots will have a brightness proportional to the multiplicity of the root, and you can change the colors, convolution properties, etc., although it doesn't provide axes (you'll have to figure that out yourself). ...


18

Update ticks[x1_, x2_] := {#/10 + π/2, #} & /@ FindDivisions[{10 (x1 - π), 10 (x2 - π)}, 20] funcs = Table[3 + BesselJ[i, 10 (x -π/2)], {i, 0, 3}]; PolarPlot[funcs // Evaluate, {x, -π/2, 3π/2}, PolarAxes -> Automatic, PolarTicks -> {ticks[0, 2 π][[2 ;; -2]], Automatic} ] (*thanks @kguler 's and @rm-rf 's advice*) Manipulate ...


18

Method 1: FindCurvePath (as mentioned by Yves Klett). This method is simple, but unfortunately, there are small issues (as shown in plots), that the curves are not identified perfectly. arrayData = Flatten[Function[{lst}, {First @ lst, #} & /@ Rest[lst]] /@ originalData, 1]; curvesPosition = FindCurvePath[arrayData]; ListPlot[curves = ...


18

Ok, here's a very brief toy example while I don't have access to my desktop computer at work. It's easy enough to figure out, that a LogPlot of f is basically the plot of Log[f[x]]. And A LogLinearPlot is the plot of f[Exp[x]]. But we can extend this to arbitrary scalings of the axes. I start with defining a piecewise function which maps x values between 0 ...


17

To long for a comment, but here's one approach, using information readily available in the docs and on this site: First, make a map that wraps a globe changing the Geoprojection to something a bit more useful. img = With[{Δ = 30}, Row[Table[ GeoGraphics[GeoBackground -> GeoStyling["ReliefMap"], GeoRange -> {{-90, 90}, {λ, λ + Δ}}, ...


17

data = Table[{RandomReal[{-10, 10}], RandomReal[{-10, 10}]}, {i, 1, 300}]; L0 = ListPlot[data, Frame -> True, Axes -> False, AspectRatio -> 1, ImageSize -> 400, BaseStyle -> PointSize[.02]]; Using @rm-rf's function inPolyQ inPolyQ[poly_, pt_] := Graphics`Mesh`PointWindingNumber[poly, pt] =!= 0 from this Q/A: Deploy@ ...


17

One way (whew, there are a lot of intersections! -- here's a shorter version): sol = NSolve[{Sin[10 t], Sin[9 t]} == ({Sin[10 t], Sin[9 t]} /. t -> s) && 0 <= t < s < 2 Pi, {t, s}]; ParametricPlot[{Sin[10 t], Sin[9 t]}, {t, 0, 2 π}, Epilog -> {Red, PointSize[Large], Point[{Sin[10 t], Sin[9 t]} /. sol]}] ({Sin[100 t], ...


16

RegionFunction is the option you are looking for. ContourPlot[ Evaluate[Sum[Sin[RandomReal[5, 2].{x, y}], {5}]], {x, -3, 3}, {y, -3, 3}, BoundaryStyle -> {Thick, Black}, RegionFunction -> Function[{x, y, z}, x^2 + y^2 < 9] ]


16

A crude attempt This is for Mathematica 10+ only. To construct each face, I use an intersection between a unit 3-ball centred at the origin and a pyramid whose base is at infinity and apex is at the origin. Each edge of the pyramid passes through each vertex of the spherical face. The pyramid is given by ConicHullRegion[{origin}, {vertices}]. The ...


16

$(x^2+y^2-1)^2+(y^2+z^2-1)^2+(x^2+z^2-1)^2=0$ is satisfied by a set of points. This can be established: f = (x^2 + y^2 - 1)^2 + (y^2 + z^2 - 1)^2 + (x^2 + z^2 - 1)^2; FullSimplify[Reduce[f == 0, {x, y, z}, Reals]] Reduce[x^2 + y^2 == 1 && z^2 + y^2 == 1 && x^2 + z^2 == 1, {x, y, z}] i.e. (x == -(1/Sqrt[2]) || x == 1/Sqrt[2]) && ...


15

In analytic geometry, the ellipse is defined as the set of points (X,Y) of the Cartesian plane that, in non-degenerate cases, satisfy the implicit equation with and where Lets fit points with second-order curve (which include ellipse). elipse = a11*x^2 + a22*y^2 + 2*a12*x*y + 2*a13*x + 2*a23*y + a33; coeff = {a11, a22, a12, a13, a23, a33}; ...


15

Update Compare two pictures. First is able to make mistake like you made the code. You need to do like this code using Mod[ArcTan[x, y], 2π]. h[r_,θ_] := 2 < r <= 5 && 3/4 π < θ < 3/2 π RegionPlot[ h[Sqrt[x^2 + y^2], Mod[ArcTan[x, y], 2π]], {x, -6, 6}, {y, -6, 6}] So I suggest to use ParametricPlot like this. rg = 6; mg = ...


15

Edit Here is a version that avoids the use of Inset and instead uses Overlay. I think this version covers all of the OPs requests. I have not tried to functionalize the code at this point since there will likely be some tweaking of parameters based on the actual functions plotted. optsall = {Axes -> False, Frame -> True, ImageSize -> 600, ...


15

Update: With the function top defined in the original post you can replicate all the cool things you see in rm-rf's answer in the linked Q/A. For example, with a slight modification of gr1, i.e., Graphics3D[hexTile[20, 20] /. Polygon[l_] :> {Directive[Orange, Opacity[0.8], Specularity[White, 30]], Polygon[l], Polygon[{Pi/5, 0} + {-1, 1} # & ...



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