Tag Info

Hot answers tagged

61

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 ...


46

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 ...


32

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, ...


21

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", "---"}, ...


19

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: ...


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 ...


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@ ...


13

Composition[ {#, Scale[#, {-1, 1}, {0, 0}]} &, Rotate[#, Pi/2, {0, 0}] &, First ] /@ Table[ With[{root = FindRoot[D[BesselJ[i, x], x], {x, 100}][[1, 2]]}, PolarPlot[{1 + BesselJ[i, t root/Pi]}, {t, 0, Pi}, PlotStyle -> {Thick, Blend["AvocadoColors", i/15]}] ] , {i, 0, 15}] // Graphics[#, ImageSize -> 500, ...


12

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}]


10

Here's a very simple example of a circular "eraser" which you can move around with the mouse and adjust the radius with a slider. Then click the button to remove points within the circle from data. DynamicModule[{pt = {0, 0}, r = 3}, Column[{ Slider[Dynamic[r], {0.1, 5}], Button["Delete", data = Select[data, EuclideanDistance[#, pt] > r &]], ...


9

On-screen, lines are always at least 1 pixel wide in Mathematica, regardless of the thickness setting. Not sure what you tried with Opacity, as it seems to be possible to achieve the same effect: PlotStyle -> Directive[AbsoluteThickness[1], Opacity[.05]]


8

Introduction I worked up my solution and then saw that Jens had suggested this approach in a comment. Well, here's my approach. It is fairly general. I made no attempt to determine how many connected components there are and finding parametrizations of each one. Find a point on the intersection. This could be a difficult step, depending on how much is ...


8

While I like gpap's solution, it requires quite a bit of work. So, instead, use the built-in options. The important one is FaceGrids which takes a list of vectors which specify which side the grid is on. Plot3D[x + y + 1, {x, 0, 1}, {y, 0, 1}, RegionFunction -> Function[{x, y, z}, 0 <= y <= Sqrt[x]], FaceGrids -> {{-1, 0, 0}, {0, 1, 0}, {0, ...


8

a[x_, y_] := (x^2 - 3 - 9*y)^2 + 50*y^2 Plot3D with MeshFunctions Using a single Plot3D with multiple MeshFunctions: Plot3D[a[x, y], {x, -13, 13}, {y, -.001, 12.1}, PlotStyle -> Opacity[.5], BoundaryStyle -> None, Boxed -> False, BoxRatios -> 1, MeshFunctions -> {#2 &, ConditionalExpression[Derivative[1, 0][a][#, #2], ...


8

r = RandomVariate[NormalDistribution[0, 1], 1500]; custom = NormalDistribution[#, 1] & /@ Range[0, 2, .4]; (* to be replaced with your custom1, custom2, ... *) You can do one of several things: Make a single Plot instead of five separate ones Show[Histogram[r, Automatic, "PDF"], Plot[Evaluate[Tooltip[PDF[#, x], #] & /@ custom], {x, -3, ...


7

@Kuba, @Rolf Mertig-s comments are summarized by this. f = PlaneCurveData["Superformula", "PolarEquation"][2, 2, 24, 6, 6, 1,1][t]; PolarPlot[{1.1, 2.0, f}, {t, 0.0, 2.0 Pi}, PolarTicks -> {Table[{i, 180° i/ π}, {i, 0, 11 π/6, π/6}], {{1.1, Framed[Style[1.1, 12, Bold], Background -> White]}, {2., Framed[Style[2., 12, Bold], Background ...


7

You need to replace White by Transparent: data = ReadList["~/Downloads/data_smp.out", Number, RecordLists -> True]; getColor[m_List, i_Integer] := Module[{s = m[[i, 6]]}, Which[s == 11, Green, s == 12, Darker[Green], s == 21, Yellow, s == 22, Orange, s == 31, Pink, s == 32, Lighter[Magenta], s == 99, Brown, s == 1, Transparent, s == 2, Red, ...


7

If you really want a parabola primitive from 3 points, you can use Fit to fit a parabola to the three points, Plot to plot it, and Cases to extract the Line primitive from the plot. For example parabola[pts_] := Module[{x, func, xmin, xmax}, func = Fit[pts, {1, x, x^2}, x]; xmin = Min[pts[[All, 1]]]; xmax = Max[pts[[All, 1]]]; Cases[Plot[func, {x, ...


7

PieChart[Labeled[#, #, If[# < 5, "RadialCallout", "RadialCenter"]] & /@ Range[10], SectorOrigin -> {Automatic, 1}] PieChart3D[Labeled[#, #, If[# < 5, "RadialCallout", "RadialCenter"]] & /@ Range[10], SectorOrigin -> {Automatic, 1}, ChartElementFunction -> ChartElementDataFunction["ProfileSector3D", "Profile" -> ...


7

I believe this is what you want? ListLinePlot[ {{0, 0}, {1, 2}, {3, 4}, {4, 2}, {6, 0}}, InterpolationOrder -> 0, Frame -> True ] /. Line[x : {{_, _} ..}] :> (Line /@ Partition[x, 2]) Post-processing of the Graphics expression generated by ListLinePlot is used in the form of ReplaceAll. The Line is split into pairs of points using ...


7

One can use the (undocumented?) option ColorRules: Import["ExampleData/caffeine.xyz", ColorRules -> {"H" -> Red, "C" -> Black, "N" -> Darker@Green, "O" -> White}] Addendum: Other options may be found here: Options[Graphics`MoleculePlotDump`iMoleculePlot3D]. Note: The option ColorFunction seems to be unimplemented.


7

Using code from the mentioned 9447, with some patches data = Transpose@{{"First", "Second", "Third"}, Table[Accumulate[RandomReal[{-1, 1}, 500]], {3}]}; hover[data_] := Module[{mouse}, mouse = MousePosition[{"Graphics", Graphics}, {99999, 99999}]; {Text[Style[Framed@Column[ (Row[{#[[1]], ": ", #[[2, Min[Length@#[[2]], Max[1, ...


7

You have to add the index for the colors to LineLegend Legended[Grid[{{Show[oniplot], Show[cpplot]}}], LineLegend[97, {"factor = 2", "factor = 3", "factor = 4", "factor = 5"}]] In order to have the legend above the plots and with markers: Legended[GraphicsGrid[{{Show[oniplot], Show[cpplot]}}], Placed[LineLegend[97, {"factor = 2", "factor = 3", ...


6

Essentially the Axis is in the wrong place. A more dramatic example: BarChart[{{1, 2, 3}, {3, 1, 2}}, BarSpacing -> {0, 2}, GridLines -> {None, Range[3]}, AxesOrigin -> {3, 0} ] You can correct this with PlotRangePadding -> 0 (as already proposed) or you can use a Frame instead: BarChart[{{1, 2, 3}, {3, 1, 2}}, BarSpacing -> {0, ...


6

I propose RegionPlot3D RegionPlot3D[ x^2 + y^2 + z^2 < 1 && x^2 + y^2 < x, {x, -1, 1}, {y, -1, 1}, {z, -1,1}, Mesh -> None, PlotPoints -> 100]


6

First, here is a trick to see the actual space used by the plot: Grid[{{Plot[Sqrt[100 - x^2], {x, 0, 100}, PlotRange -> Automatic, ImageSize -> {250, 100}]}}, Frame -> All] Grid[{{Plot[Sqrt[100 - x^2], {x, 0, 100}, PlotRange -> Automatic, ImageSize -> {500, 100}]}}, Frame -> All] So you can see that it did actually use ...


6

ListPointPlot3D[ Table[{Cos[t], Sin[t], 2 + Sin[t] Cos[t]^2} ,{t, 0, π, 0.01}] , Filling -> 0]


6

opts = {MeshFunctions -> (#4 &), MeshShading -> {{Opacity[#2], #1}, {Opacity[#2/2], #1}}, BoxRatios -> {1, 1, 1/2}, BoundaryStyle -> Directive[Thin, Blue]} &; Show[ ParametricPlot3D[{Cos[t], Sin[t], z (2 + Sin[t] Cos[t]^2)}, {t, 0, π/2}, {z, 0, 1}, Evaluate@opts[Green, .4]], ...


6

If you just wrap your data with TemporalData, you can Plot or DiscretePlot the "PathFunction". In either case, there is no need for additional post- or pre-processing of the data to deal with jumps. data = {{0, .5}, {1, 2}, {3, 4}, {4, 2}, {6, 1}}; td = TemporalData[data]; Using Plot and the Exclusions option: Plot[Quiet@td["PathFunction"][x], {x, 0, ...


6

Because the local minima in $x$ are the zeros of the $x$-derivative, you could do something like this: Plot3D[a[x, y], {x, -13, 13}, {y, 0, 12}, MeshFunctions -> {Derivative[1, 0][a]}, Mesh -> {{0}}] This also includes the local maxima, but you can get rid of them by requiring the second derivative in $x$ to be positive. Then we remove the ...



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