Tag Info

New answers tagged

0

Try this: ListPlot3D[values, MeshFunctions -> {Function[{x, y, z}, Sin[x]^2 + 2 y]}] This produces a pretty low-quality output for the given example, but the more points you have in the ListPlot the more points are used in calculating the contours for the mesh. For example: ListPlot3D[ Join @@ Table[{x, y, Abs[Sin[x + I y]]}, {x, -Pi, +Pi, ...


7

Both, DensityPlot and Graphics, with primitives like Circle and Disk, produce Graphics output. I think it is alright implementing your custom graphics. Here's my take, following your second idea, with a simple control over how the opacity fades. smooth[a_, R_: 1, n_: 100, hue_: Purple] := Graphics@Table[{ Blend[{Append[0]@hue, Append[1]@hue}, ...


4

Another way: circim = Graphics[{White, Disk[]}, Background -> Black]; ImageMultiply[LinearGradientImage[{Blue, Yellow, Red}], circim] Or ImageMultiply[RadialGradientImage[{Blue, Yellow, Red}], circim] One can compose such a figure with transparency as: ImageCompose[EiffelTower, {mybullseye, .5}] where the .5 is the transparency ...


8

Using Frame->False instead of Axes->False for your first approach seems to work well.


9

Here`s an alternative. pic = Import["http://i.stack.imgur.com/4xyhd.png"] Let's say you are lazy and you don't want to write mathematical equations. We can use built-in transformations to create domain, image of transformation, and create InterpolationFunction based on this data. data = Join @@ Table[{lat, long}, {lat, -89, 89}, {long, -179, 179}]; ...


3

First, some remark : with Mathematica you don't have to "initialize" lists : you can directly input set1 and set2 like this : set1 = {"A" -> "B", "B" -> "C", "D" -> "F", "A" -> "F", "G" -> "B", "H" -> "C", "C" -> "G"}; set2 = {"B" -> "A", "B" -> "C", "D" -> "G", "A" -> "F", "G" -> "H", "H" -> "D", "B" -> ...


4

Based on data in Comm ACM. This took a while to only partially automate, largely through a helper function that spreads out the years: diffuse[a_][years_List] := Module[{x0 = 1, x1 = Length[years], y0 = Min[years], y1 = Max[years]}, years // MapIndexed[ {#1, (((y1 - y0)/(x1 - x0))*(First[#2] - x0) + y0) a + (#1) (1 - a)} ...


1

Tak a closer look at documentation: data = RandomReal[1, {100, 2}]; Histogram3D[data, {{.2}, {.5}}] The following bin specifications bpsec can be given: {w} use bins of width w (...) {xspec,yspec} give different x and y specifications ergo: {{wx}, {wy}}


4

Using RegionNearest Imagine the triangle as a one-dimensional region, r1, a line, embedded in a plane. r1 = Line[{{0, 0}, {3, 1}, {2, 0}, {0, 0}}]; RegionDimension[r1] RegionEmbeddingDimension[r1] 1 2 Get the radius of a circle, with the triangle centroid as center, that intersects the farthest vertex of the triangle. c = RegionCentroid[r1]; (* ...


13

If you interpret your geometric shape as NURBS of degree 1 (linear), you can proceed with the following, extremely simple code: pts={{0, 0},{1, 1},{0.5, 1.5}}; (* just an example *) s=BSplineFunction[pts,SplineClosed->True,SplineDegree->1]; Animate[ParametricPlot[s[t],{t,0,1},Epilog:>{Red,PointSize[Large],Point[s[t]]}],{t, 0., 1.}] This yields ...


1

Internally LineScaledCoordinate use Position[d, _?(#1 >= t &)] to detect a current segment. Here d is an accumulated list of distances (relative to the total length of segments). However, algebraic expressions are not atomic: t = 0.5; d = {0, 1/(3 + Sqrt[2]), 3/(3 + Sqrt[2]), 1}; Position[d, _?(#1 >= t &)] Position[N@d, _?(#1 >= t ...


6

e = {{0, 0}, {1, 1}, {5.5, 1.5}, {0, 0}}; (*triangle vertices*) (*point position as a function of time*) p[t_, e_] := Piecewise[{ {(1 - t)*e[[1]] + t*e[[2]], 0 <= t <= 1}, {(1 - (t - 1))*e[[2]] + (t - 1)*e[[3]], 1 < t <= 2}, {(1 - (t - 2))*e[[3]] + (t - 2)*e[[1]], 2 < t <= 3} }]; (*animation*) Animate[ Show[ ...


6

Thanks to kguler, I now know there is something like: LineScaledCoordinate. vertices = Table[{Cos[i], Sin[i]}, {i, 0, 2 Pi, 2 Pi/3.}]; Needs["GraphUtilities`"] Slider[Dynamic@t] Graphics[{ EdgeForm @ Thick, FaceForm @ None, Polygon @ vertices , AbsolutePointSize @ 12, Red, Dynamic[Point[LineScaledCoordinate[vertices, t]]] } ] Just in ...


2

This is consistent with how Show handles options in general. Show will combine the graphics from the first (p1) and the second (p2) Graphics expression. But all the options of the result will simply be inherited from the first one (p1). The options of the second one (p2) are ignored. Epilog is handled the same way as all the other options: it is ...


1

as I can see the problem is that in NIntegrate s is localised. define a function for your expression f[s_] := Log[(E^(4 n qhat s) (1 - qhat)^(-1 + 4 n \[Mu]) qhat^(-1 + 4 n \[Nu]))/NIntegrate[E^(4 n qhat s) (1 - qhat)^(-1 + 4 n \[Mu]) qhat^(-1 + 4 n \[Nu]), {qhat, 1/(4 n + 1), 1 - 1/(4 n + 1)}, MaxRecursion -> 12]] and then the plot works ...


8

array = {{680*4, 509*4}, {739*4, 622*4}, {644*4, 741*4}, {606*4, 856*4}, {749*4, 474*4}, {977*4, 542*4}, {601*4, 481*4}, {584*4, 604*4}, {866*4, 667*4}}; pic = ImageResize[ExampleData[{"TestImage", "Lena"}], {4000}]; Show[{ pic, Graphics[{Yellow, Line@Subsets[array, {2}] }] }, ImageSize -> 400]


0

a P1 + (1-a) P2 for 0 < a < 1.


4

It is perhaps easier (or almost so) to build this kind of chart from graphics primitives as to build it with BarChart. Here is a function that works that way. breakdownChart[ vals_List, lbls_List, wd_Integer /; wd >= 100, ht_Integer /; ht >= 20] /; Length@vals == Length@lbls := With[{totl = Total @ values}, With[{barSize = Round[wd ...


3

Bottom-up approach using Accumulate: {10, 25, 50, 15} // Prepend[0] // Accumulate // Partition[#, 2, 1] & // Map[{ColorData["HTML", RandomInteger[{1, 10}]], Rectangle[{First[#], 0}, {Last[#], 1}]}~ Join~ {Black, Text[Last[#], {Last[#], -1/4}]} &] // Graphics[#, AspectRatio -> 1/5] & RandomInteger color selection is not ...


6

Here's one way to to it with BarChart. I didn't spend too much time on formatting the Tooltip. names = {"apps", "pics", "vids", "free"}; vals = {10, 25, 50, 15}; BarChart[ Table[Tooltip[vals[[i]], Column[{ Style[names[[i]], 16, Bold], Style[ToString[vals[[i]]] <> " GB", 16, GrayLevel[0.5]]}], TooltipStyle -> {CellFrameColor -> ...


4

Here is another way using a different set of DiscretePlot's options. Show[ DiscretePlot[x^2, {x, 1, 4, 0.5}, PlotRange -> {{1, 4.01}, {0, 16.01}}, PlotRangeClipping -> True, AxesLabel -> {x, x^2}, Ticks -> {Automatic, Range[0, 16, 2]}, ExtentSize -> Left, ColorFunction -> (Green &), ExtentElementFunction ...


1

To render the filling rectangles with black edges, you can use the option FillingStyle with EdgeForm[Black]: Show[DiscretePlot[x^2, {x, 1, 4, 0.5}, ExtentSize -> Left, FillingStyle -> Directive[Opacity[1], Green, EdgeForm[Black]]], Plot[x^2, {x, 0, 4}, PlotStyle -> Directive[Thick, Black]]] You can also use Epilog in DiscretePlot to have all ...


4

This is nontrivial due to PlotRangeClipping, FaceForm, FaceForm, etc. Show[ DiscretePlot[x^2, {x, 1, 4, 0.5}, ExtentSize -> Left, PlotRange -> {{1, 4}, {0, 16}}, PlotStyle -> Directive[Black, FaceForm[{Opacity[1], Green}], EdgeForm[Black]], Ticks -> {Automatic, Range[2, 16, 2]}], Plot[x^2, {x, 0, 4}, PlotStyle -> ...


2

An alternative syntax using FillingStyle explicitly data = {{1, 1.5}, {2, 3}, {3, 5}, {4, -1}, {5, -9}, {6, 1}, {7, 10}}; L0 = ListPlot[data, Joined -> True, Axes -> False, Frame -> True, PlotRange -> {{1, 7}, {-10, 10}}, PlotStyle -> Directive[Black, AbsoluteThickness[5]], Filling -> {1 -> Top, 1 -> Bottom}, FillingStyle ...


2

data2 = {{1, 10}, {7, 10}}; data = {{1, 1.5}, {2, 3}, {3, 5}, {4, -1}, {5, -9}, {6, 1}, {7, 10}}; L0 = ListPlot[{data2, data}, Joined -> True, Axes -> False, Frame -> True, PlotRange -> {{1, 7}, {-10, 10}}, Filling -> {1 -> {{2}, Green}, 2 -> {Bottom, Red}}, PlotStyle -> {Automatic, {Black, Thickness[0.02]}}] you ...


0

Try to add the following lines to your code in order to decrease the pdf-file size. plot = Rasterize[plot, RasterSize -> 1000, ImageSize -> 650,ImageResolution -> 1000]; Export["plot.pdf", plot]; This method give us a file of aproximatelly 200kB instead of the previous 11MB. If you want an eps-file, is better to convert the pdf-file rather than ...


5

If you start with the topmost entity and then work your way down step by step you won't miss any data. However, you are correct that some map coordinates appear to be missing: divisions = CountryData["SierraLeone", "AdministrativeDivisions"]; subdivisions = AdministrativeDivisionData[#, "Subdivisions"] & /@ divisions; GeoGraphics[{EdgeForm[Black], ...


1

The third argument to Text can be useful in situations like the one you describe. Perhaps this example will give you the info you need to proceed. align[Right] = {1, 0}; align[Center] = {0, 0}; (* default *) align[Left] = {-1, 0}; lText = Text["Left Aligned", {0.5, 0.6}, align[Left]]; cText = Text["Centered", {0.5, 0.5}, align[Center]]; rText = ...


1

The answer is in the docs yet it might be useful for others so I will just drop it here. The Details and Options section of the Text documentation says: Thus you can do the following: Plot[x, {x, 0, 1}, Epilog -> {Text[Style["hello", 25], Scaled[{0.5, 0.5}], #], Red, Point@{.5, .5}}, PlotLabel -> ToString@#] & /@ {{-1, 0}, {1, 0}, ...


0

Maybe you could try this: bc = Plot[{Sqrt[1 - x^2], -Sqrt[1 - x^2]}, {x, -1, 1}, PlotRange -> {-1.2, 1.2}, PlotStyle -> Black, Axes -> False, AspectRatio -> Automatic]; sc = Plot[{(Sqrt[1/4 - x^2]) + .5, (-Sqrt[1/4 - x^2]) + .5}, {x, -1, 1}, PlotRange -> {-1.2, 1.2}, PlotStyle -> Black, AspectRatio -> Automatic, Axes -> ...


0

I drew a contour plot by defining Contours as 5,If it looks something like what your are expecting we may be on the right track.However I can't do the List Plot because gs5Matrix5 is not defined. Rm5[θ_, v_] = Rm0 + dR1*f[θ, v] + dR2*g[θ]; g[θ_] = If[θ >= 90, Cos[(θ*π)/180]^2, 0]; m5[θ_, v_] = m0 + dm*f[θ, v]; m5values = {ϵ0 -> 180.51, dϵ1 -> ...


4

I reported the issue to WRI on November 21. On December 16 they confirmed that it is a known bug. (I forgot to update the question till now.)


3

Here is a version that takes as a reference a Plot of the two functions. It will only work if the x-range and the y-range are of the same magnitude. If not the placement of the axes labels will be screwed. (* Plot the original function *) X[ϵ_] := 1 - 0.5 ϵ x[r_] := -0.5 + 0.5 r p = Plot[{X[r], x[r]}, {r, -1, 1}]; (* Get the attributes of the plot p *) pl = ...


2

Xf[ϵ_] := 1 - 0.5 ϵ xf[r_] := -.5 + 0.5 r; blueaxis = {Directive[Blue, Thick, Arrowheads[{0, .05}]], Arrow @@ # &}; redaxis = {Directive[Red, Thick, Arrowheads[{-.05, 0}]], Arrow @@ # &}; txtF = Text[Style[#, 20, Italic], #2] &; axeslabels = txtF @@@ Transpose[{{"ε", "r", "+X", "-X", "-(-X)", "+(-X)"}, {{.1, 2.7}, {-.1, -.7}, {.8, .3}, ...


3

As halmir commented the documentation of EdgeStyle notes the following possible issue: Thus you should use \[DirectedEdge]: Graph[ {"ftr1" \[DirectedEdge] "ftr2", "ftr2" \[DirectedEdge] "ftr3", "ftr3" \[DirectedEdge] "ftr4"}, EdgeStyle -> {"ftr1" \[DirectedEdge] "ftr2" -> Black, "ftr2" \[DirectedEdge] "ftr3" -> Blue, ...


5

You just need to insert the correct potential, (and change plot function since we lose azimuthal symmetry). For example, we can create a smaller dimple at the position (2,2) Plot3D[-1/Sqrt[(x^2 + y^2)] - .1/Sqrt[((x - 2)^2 + (y - 2)^2)], {x, -4, 4}, {y, -4, 4}, Boxed -> False, Axes -> False, Ticks -> None, PlotStyle -> ...


2

ParametricPlot3D[ {x, y, -1/Norm[{x + 1, y}] - 1/Norm[{x - 1, y}]}, {x, -4, 4}, {y, -4, 4}, PlotRange -> {{-4, 4}, {-4, 4}, {-5, Automatic}}, Mesh -> 20, Axes -> False, Ticks -> None, PlotStyle -> Opacity[.1]]


3

First some analysis. The slowness is due to the time it takes to compute InverseSurvivalFunction[dist, u]. InverseSurvivalFunction is a general purpose function and perhaps not optimized for mixture of normal distributions. An improvement in speed can be obtained by using some calculus to reduce the number of times we have to compute ...


2

The draw remembered me ListLineIntegralConvolutionPlot pictures. Here is a copy and past from Wolfram Reference: data=Table[{-1-x^2+y,1+x-y^2},{x,-3,3,.2},{y,-3,3,.2}]; ListLineIntegralConvolutionPlot[data,ColorFunction->ColorData["Aquamarine"],Frame->False]


4

Using ContourPlot for such a simple thing as a circle is like, well, inviting the guys from CSI to find out who has eaten your apple. A circle has a very simple parametric form and you should rather use ParametricPlot for this: pm = Normal[ ParametricPlot[rad {Cos[phi], Sin[phi]}, {phi, 0, 2 Pi}, PlotStyle -> {Red, Dashed, Thick}, ...


7

Plot the objective function f[x,y] for 100 values of x: plt = Plot[ y InverseSurvivalFunction[dist, # + y] & /@ Range[0, 1., .01], {y, 0, 1}, Evaluated -> True, ImageSize -> 400, PlotRange -> {{0, 1}, {-.1, 1}}]; Post-proces the previous plot to mark points corresponding to the global maximum on each of the 100 curves: plt /. ...


1

ContourPlot works best on nonconstant, continuous functions, so one ought to expect to have to do some extra work when the function is discontinuous or, as in this case, constant on a region. In this case, the default behavior makes a choice that rather forces the user to make a choice about how to represent the function accurately. The particular issue is ...


3

Here is another approach, contour just one of the segments, reflect it then make 6 rotated copies of the arc.. P00 = Show[{{Normal@ ContourPlot[f[x, y] == rad, {x, -xmin, xmin}, {y, -xmin, xmin}, ContourStyle -> {Red, Dashed, Thick}, PlotPoints -> 200, PerformanceGoal :> "Quality", RegionFunction -> (V[#1, #2] < h ...


1

Approach from my comment, getting rid of the reflection and directly contour plotting the outer circles. This is actually slower, but somehow a more satisfying approach.. V[x_, y_] := ω^2/2*(x^2 + y^2) - \[Epsilon]*(-(x^6/6) + 5/2*x^4*y^2 - 5/2*x^2*y^4 + y^6/6); f[x_, y_] := x^2 + y^2; ω = 1; \[Epsilon] = 1; h = 1.1; rad = 1.8*h; xmin = 2; pint = {x, y} ...


10

The problem occurs because z = Normal@ContourPlot[f[x, y] == rad, {x, -xmin, xmin}, {y, -xmin, xmin}, ContourStyle -> {Red, Dashed, Thick}, PlotPoints -> 200, PerformanceGoal :> "Quality", RegionFunction -> (V[#1, #2] < h &), MaxRecursion -> 4] contains seven Lines, not six (because the Line representing the original dashed ...


8

data = Table[Sin[i + j^2], {i, 0, 3, 0.05}, {j, 0, 3, 0.05}]; ListContourPlot[data, ColorFunction -> "Rainbow", Contours -> {{0, {Thick, Black}}, {-.5, {Thick, Dashed, Black}}, Sequence @@ ({#, None} & /@ Range[Min@data, Max@data, .0025])}] You can also use the desired contours as Epilog with ListDensityPlot: lcp = ...



Top 50 recent answers are included