New answers tagged

2

You have problem because your variable a is already a graphics object. This works for me: file = Export["fig.pdf", Plot[Sin[x], {x, 0, 2 π}]] g = First[Import[file]] Graphics[{g[[1]], Inset[x^2 + y^2 == 1, {200, 200}]}]


1

It seems that the left hand corner is not at the position {0,0} so I have included an offset different from {0,0}: Clear[ leftCorner ]; leftCorner[ x_, y_, w_, h_ ] := With[ { offset = {50, 80} (* the position of the left hand corner of the grid *) }, { Quotient[ x, w ], Quotient[ y, h ] } × {w, h} + offset ] leftCorner[ 230, 180, (* w = *) ...


2

As far I can tell your problems are due to rasterization that you introduced into your graphics output. You need to tell us how you made the enlarged image of the small part of your output that you show us, because if you were to let Mathematica plot from exact numbers and do the magnification, the graphics look great, even when no Antialiasing -> True ...


5

EDIT My original post was unnecessarily complex (pun?) and I have taken the advice of Kuba. This is not really an advance but I post it for fun: v1 = {2, 1}; v2 = {-1, 1}; f[x_, y_] := {x, y}.{v1, v2}; Manipulate[ Row[{Show[Plot[{x, x^2, 5 Sin[x]}, {x, 0, 5}, PlotRange -> {0, 5}], ParametricPlot[{x, y}, {x, 0, 5}, {y, 0, 5}, MeshFunctions ...


8

I am writing this answer only to address the Wizard's comment of "not obvious". Recall that if you take two nonzero vectors $\mathbf v_1$ and $\mathbf v_2$ as your basis, you can then represent any other vector as a linear combination of these two ($x \mathbf v_1 + y \mathbf v_2$). In Mathematica, this is equivalent to the expression Transpose[{v1, v2}].{x, ...


14

Your code works fine, but it's missing half the roots, and a Flattening 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, ...


1

Perhaps this is a solution for the 2D case. lattice[basis : {Repeated[{_Real, _Real}, {2}]}, nX_Integer?Positive, nY_Integer?Positive] := Module[{box, sides}, box = Sort /@ Transpose[basis]; sides = Flatten[Abs[Differences[#]] & /@ box]; Flatten[CoordinateBoundsArray[box, sides, 0, {{0, nX - 1}, {0, nY - 1}}], 1]] With[{basis = {{1, ...


0

LatticeData["FaceCenteredCubic", "Image"] and try: LatticeData[#, "Image"] & /@ LatticeData[3]


10

Code phasePortrait[f_, {{xmin_, xmax_}, {ymin_, ymax_}}] := Plot[ f[x], {x, xmin, xmax}, Frame -> True, PlotStyle -> Directive[Black, Thick], ImageSize -> 500, PlotRange -> {{xmin, xmax}, {ymin, ymax}}, Epilog -> {getMarkers[f], getArrows[f, {xmin, xmax}]} ] right = Triangle[{{2, 0}, {-1, 1}, {-1, -1}}]; left = Triangle[{{-2, 0}, ...


7

One way of coding the iterations may be defined as follows. The function CollatzFractal01[z0] returns a list {Abs[z],iter}, where Abs[z] is the final value of z, and iter is the number of iterations required to escape the bound of Abs[z]>200. Use compilation and parallelisation for speed. CollatzFractal01 = Compile[{{z0, _Complex, 0}}, Module[{iter = ...


7

Here's a somewhat ridiculous way to achieve that: ListPlot[ {Labeled[{0, 0}, "The first point"], Labeled[{1, 1}, "The second one", Left]}, Axes -> False ]


3

While using a computer often means you don't have to worry if there is a large number of polynomials approximating data piecewise, the OP wishes to find a simple polynomial or two that roughly approximates the data. Here is an approach. Please note that data fitting and smoothing is not my forte; but the mathematics used here is fun and too alluring for me ...


7

Manipulate[ pascal = Row[Pane[#, 50, Alignment -> Center] & /@ #] & /@ Table[CoefficientList[(x + 1)^i, x], {i, 0, n - 1}]; product = Pane @ StringPadLeft[ToString[#], 40, "."] & /@ Table[(j!)^(j - 1)/BarnesG[j + 1]^2, {j, 0, n - 1}]; Grid[{{ Column[pascal, Center], Column[product, Right] }}, BaseStyle -> 15] , ...


7

Solution for Update1 The ellipses described by matThetaList can be plotted by Show[ParametricPlot[#[[1]].{Sin[θ], Cos[θ], 1}, {θ, 0, 2 Pi}] & /@ matThetaList, PlotRange -> All] To describe each of these four curves as an ImplicitRegion, first eliminate θ from the parametric equations given in the question, h = Total[#^2 & /@ ({Sin[θ], ...


2

Animate[Plot[Sin[a*t], {t, 0, 2}, PlotRange -> {0, 2}, Epilog -> Text[Style[Row[{"a value =", Pane[a, Alignment -> Right, ImageSize -> {50, Automatic}], " some more text"}], Bold, Blue, 15], {0.8, 1.5}]], {a, 0, 11, 0.1}]


5

[...] however i would like to build approximation function, that go through as many points as it can. So how can I do that? As What I ideally trying to make is two approximation functions for each half of the graph that go through as many points as it can. This can be easily done with Quantile Regression. Data First let us generate some data: ...


6

Maybe you could fix the left-hand end of the text position, something like this: Animate[Plot[Sin[a*t], {t, 0, 2}, PlotRange -> {0, 2},Epilog->Text[Style[Row@{"a value = ", a}, Bold, Blue, 15], {0.8, 1.5}, {-1, 0}]], {a, 0, 10, 0.1}]


6

I did some time ago. tv = 225; te = 365.25; rv = 0.72; re = 1; e[t_] := {Cos[2 Pi t/te], Sin[2 Pi t/te]}; v[t_] := 0.72 {Cos[2 Pi t/tv], Sin[2 Pi t/tv]}; vis[t_, s_] := Graphics[ {Yellow, PointSize[0.05], Point[{0, 0}], White, Circle[{0, 0}, 1], Circle[{0, 0}, 0.72], Blue, PointSize[0.03], Point[v[t]], Red, Point[e[t]], White, ...


10

Might as well... eorb = PlanetData["Earth", "OrbitPath"]; vorb = PlanetData["Venus", "OrbitPath"]; dl = DateRange[{2010, 1, 1}, {2015, 12, 31}, "Week"]; epos = Table[QuantityMagnitude[UnitConvert[ PlanetData["Earth", EntityProperty["Planet", "HelioCoordinates", {"Date" -> dates}]], ...


4

See for a start Cardioid or Cardioid, Wiki. If i'm not mistaken this stuff is called Line Art, String Art and Curve Stitching. (Code Intellectual property of Matt Henderson of http://blog.matthen.com) Manipulate[Graphics[{Table[Line[{{Sin[a], Cos[a]}, {Sin[a + 2 Pi/3 + t], Cos[a + 2 Pi/3]}}], {a, 0, 2 Pi - 0.001, Pi/50}]}, PlotRange -> {{-1, 1}, {-1, ...


5

With the caveat that it has zero physical meaning whatsoever, here you go: \[Omega]v = 365.25/225; rv = 0.72; lines = Table[Line[{{Cos[t], Sin[t]}, rv {Cos[\[Omega]v t], Sin[\[Omega]v t]}}], {t, 0, 20 \[Pi], \[Pi]/40}]; Graphics[{White, Opacity[0.4], lines, Opacity[1], Red, Circle[], Circle[{0, 0}, rv]}, Background -> Black] And if you want an ...


10

Here's something that is nowhere near the sophistication of the original, but might get you started. The following assumes an orbital period for Venus of 225 days (thanks Michael!), and an average orbital distance from the sun of 0.72 AU (from very superficial Google searches). Table[ Module[ {venus, earth}, venus = 0.72 AngleVector[2 Pi/225 d]; ...


7

Here, I applied the discrete strategy(sampling $400$ points in a period $2\pi$) to calculate the boundary of ellipses $E_1,\cdots,E_n$. The algorithm mainly consists of four steps as follows : Using the ellipses $E_2,\cdots,E_n$ to trim the black segment of the first ellipse $E_1$; Using the ellipses $E_1,\cdots,E_{n-1}$ to trim the red segment of the last ...


3

data = Table[RandomReal[], {100}, {6}]; myPts = Graphics3D[ {Red, PointSize[0.02], Point[ data[[All, {1, 2, 3}]] ]} ]; myArrows = Graphics3D[ Arrow[Transpose@{data[[All, {1, 2, 3}]], data[[All, {4, 5, 6}]]}]]; Show[myPts, myArrows]


5

Here is a standard algebraic approach, to complement @ubpdqn's geometric one. If we have a sequence of points $(x_i,y_i)$, $i=1,2,\dots,n$ lying on a circle, then the linear system $$A\,(x_i^2+y_i^2)+B\,x_i+C\,y_i+D=0,\quad i=1,2,\dots,n$$ will have a nontrivial solution $(A_0,B_0,C_0,D_0)$. If there are at least three distinct points not on a line, the ...


15

This is a motivating post. I have made no effort to deal with intersection <4 pts. I post only illustrative examples. The centre of the circle is the intersection of perpendicular bisectors of chords. f[a_, b_, c_, d_] := Module[{e1 = a x^2 + b, e2 = c y^2 + d, s, p, l, ln, ctr}, s = Solve[{x, e1} == {e2, y}, {x, y}, Reals]; p = {#, a #^2 + b} ...


2

g2 just produces the same image g1 again The new rectangles in g2 are not visible because they are all red. Change Red to a random color and they become visible: g2 = Graphics[{Rectangle[], Hue[RandomReal[]], GeometricTransformation[g1[[1]], {T1, T2, T3, T4, T5, T6, T7, T8}]}] What I want to do is apply the eight transformations to g1 again, ...


5

Manipulate[Show[Graphics[dottedCircle1[{0, 0}, Pi/2 + a, R]], Graphics[dottedCircle2[{R + r, 0}, -Pi/2 + s a, r]], AspectRatio -> Automatic], {a, 0, 2 Pi}, {{R, 1}, 0, 10}, {{r, .5}, 0, 10}, {{s, 0}, 0, 10, 1}]


0

you can create a new list with the set of values. For example list = Transpose[{Range[0, 1, 1], Range[2, 0, -2]}]; graphicsListVert = {}; graphicsListHor = {}; Do[{{n, p} = x; AppendTo[graphicsListVert, Line[{{n, p}, {n, p - 2}}]], AppendTo[graphicsListHor, Line[{{n, p - 2}, {n + 2, p - 2}}]]} ,{x, list}]


1

n = Range[0, 1, 1] p = Range[2, 0, -2] graphicsListVert = MapThread[Line[{{#1, #2}, {#1, #2 - 2}}] &, {n, p}] graphicsListHor = MapThread[Line[{{#1, #2 - 2}, {#1 + 2, #2 - 2}}] &, {n, p}]


3

The second argument of Ellipse seems to need to be a vector (and not a matrix). In any case, try rotating the object. You'll also want to change the position ({0,0} below) to get it centered where you want. Something like: Row[Plot[x, {x, -500, 500}, Epilog -> {Opacity[0], EdgeForm[Thick], Rotate[Ellipsoid[{0, 0}, {400, 200}], #]}, ...


1

Animate[PolarPlot[2 Sin[4 θ], {θ, 0, 2 Pi}, Axes -> False, MeshFunctions -> {#3 &}, Mesh -> {{{θ, Directive[Red, PointSize[Large]]}}}], {θ, 0, 2 Pi}, AnimationRunning -> False]


1

Update: Manipulate[ ParametricPlot[radius {Sin[x], Cos[x]}, {x, 0, 2 Pi}, PlotRange -> {{-10, 10}, {-10, 10}}, MeshFunctions -> {#3 &}, Axes -> True, Mesh -> {{{t, {Red, PointSize[.05]}}}}], {t, 0, 2 Pi}, {{radius, 2, "Play"}, 1, 10}] Original post: Using Clock and ParametricPlot with MeshFunctions ...


2

Example: Manipulate[ Graphics[{ Circle[], {Red, PointSize @ .05, Point@{Cos[x], Sin[x]}} }], {x, 0, 2 Pi} ] Alternatively, if you would like to animate it: Animate[ Graphics[{ Circle[], {Red, PointSize @ .05, Point@{Cos[x], Sin[x]}} }], {x, 0, 2 Pi} ] Output:


7

You can use Interpolate to interpolate between the polygon vertices: First make sure the polygon is closed, by appending the first vertex: cyclic = Append[manualPolyPoints, First[manualPolyPoints]]; then accumulate the distance from one vertex to the next: accumulatedDistance = Rescale@Prepend[Accumulate[Norm /@ Differences[cyclic]], 0.]; then ...


1

Manipulate[ Graphics[{Red, Circle[{0, 0}, Cos[Pi/n]], Blue, Circle[{0, 0}, 1], Green, Line[{Cos[2 Pi #/n], Sin[2 Pi #/n]} & /@ Range[0, 2 n]]}], {n, 3, 30, .2}]


0

styleddata1 = With[{ps = Rescale[#2, Through[{Min, Max}@d00[[All, 2]]], {5, 20}]}, Style[Tooltip[{#, #3}, #2], If[-2 <= #2 <= 2, Directive[Green, AbsolutePointSize[ps]], Directive[Red, AbsolutePointSize[ps]]]]] & @@@ d00; ListPlot[styleddata1, AspectRatio -> 1] styleddata2 = Style[Tooltip[{#, #3, Rescale[#2, ...


1

Another way is to use Graphics which gives you more control over your plot. n = 100; d00 = Table[{RandomReal[{-1, 1}], RandomReal[{-4, 4}], RandomReal[{-1, 1}]}, {i, 1, n}]; {x1, x2} = {Min[#], Max[#]} &@d00[[All, 2]]; col[x_] := If[Abs[x] < 2, Green, Red] (*for color*) scale[x_] := (x - x1)/(x2 - x1)/20 (*for point size*) ...


1

Just some variants: l = RandomReal[{-4, 4}, {200, 3}]; With[{g = #[[All, {1, 3}]] & /@ GatherBy[l, #[[2]] < 2 &]}, ListPlot[g, PlotStyle -> {Red, Green}, PlotMarkers -> {Automatic, 8}]] ListPlot[Last@Reap[Sow[{#1, #3}, #2 < 2] & @@@ l, _, #2 &], PlotStyle -> {Red, Green}, PlotMarkers -> {Automatic, 8}] ...


0

For a verry nice Q & A see Using Evaluate and Evaluated -> True in Plot Plot[{{A0 E^(-k1 t) , -((A0 E^(-k1 t - k2 t) (-E^(k1 t) + E^(k2 t)) k1)/(k1 - k2)) , (A0 E^(-k1 t - k2 t) (-E^(k1 t) k1 + E^(k1 t + k2 t) k1 + E^(k2 t) k2 - E^(k1 t + k2 t) k2))/(k1 -k2)} /. {A0 -> 1, k1 -> 4, k2 -> 10}} , {t, 2, 0} , Evaluated -> True] Plot[{{A0 ...


8

Alternatively, one can use AbsoluteOptions[] to extract the coordinates: g = RandomGraph[{20, 40}]; coords = VertexCoordinates /. AbsoluteOptions[g, VertexCoordinates]; You can verify that coords === GraphEmbedding[g] gives True.


3

Here's another option: l = RandomReal[{-4, 4}, {200, 3}]; ListPlot[ List /@ (l[[All, {1, 3}]]) , PlotStyle -> (If[Abs[#[[2]]] < 2, Green, Red] & /@ l) ] Where you can use any function that returns a color in your styling. You might want have to rescale your data if it's not in the range {0,1}. If you want to change point sizes you can ...


4

Basically a duplicate of this question. You can just style each point before you pass them to ListPlot for things like this. Define a color function: cfun = Piecewise[{{White, # <= -2}, {Green, -2 < # < 2}, {Red, # > 2}}, Black] & Then style by second element: d0 = Table[Style[{d00[[i, 1]], d00[[i, 3]]}, cfun[d00[[i, 2]]]], {i, 1, ...


2

This turned out to be pretty simple, using ClickPane to capture the clicks, and MousePosition so that you can see the current coordinates. After running the code below, and placing your mouse over the plot, the coordinates are displayed above the plot. After clicking, the coordinates you click are added to the list pts. This bypasses any interaction with ...


1

You might try to use Locatorfor this purpose. Try this: coord = {}; DynamicModule[{pt = ImageDimensions[im]/2 // N}, Column[{ Show[{ image, Graphics[Locator[Dynamic[pt]]] }], Dynamic[pt], Button["Get coordinates", Clear[coord]; coord = pt] }] ] where ´image` is the name of your image and coord is the global variable. You ...


11

While I don't know the exact details on how Gravatar generates identicons, the following might give you a something suitable. Generally speaking, identicons are generated by hashing the user data and then creating a graphic based on the hash. A common technique is to cycle through and turn pixels on or off based on whether the value of a digit in the hash ...


14

data1 = RandomVariate[NormalDistribution[0, 1], 1000]; data2 = RandomVariate[NormalDistribution[0.3, 1], 1000]; One way is PairedHistogram PairedHistogram[data1, data2] A different layout can be achieved by hacking the height specification of Histogram. Show[ Histogram[data1, Automatic], Histogram[data2, Automatic, -#2 &] ] Update In ...


2

Why not directly use ListCurvePathPlot? ListCurvePathPlot@aa


0

Perhaps you would like to use Histogram3D Manipulate[ Histogram3D[ Table[{Frequency[k, r, fmin, fmax], Amplitude[k, r]}, {k, 0, Nwaves - 1}]], {{Nwaves, 1, Style["Number of waves", 10]}, 1, 50, 1, ImageSize -> Large, Appearance -> {"Labeled", "Closed"}}, {{fmin, 0, Style["Min frequency", 10]}, 0, fmax, 0.001, ImageSize -> Large, Appearance ...


13

Yes, use GraphEmbedding. Graph is atomic and you should not try to extract any information from it by looking at its input form. It is not reliable, can change between versions, undocumented, etc. Nor is the input form directly accessible with things like Part.



Top 50 recent answers are included