Tag Info

New answers tagged

1

This is an incredibly annoying issue that led me to write my own package at one point. While we're dealing with a grid of images of equal sizes, this is easily solvable (see answers of Sjoerd C. de Vries and Alexei Boulbitch). Unfortunately, we (myself and the topic-starter, at least) often want GraphicsGrid to behave more like Grid. Compare, for example, ...


0

Try this: s0 = Plot[Sin[x], {x, -10, 10}, Frame -> True, FrameLabel -> {"x", "y"}, ImageSize -> 550]; E0 = Export["test.jpg", s0]; img = Import["test.jpg"]; S1 = GraphicsGrid[{{img, img}, {img, img}}, Spacings -> {10, -120}] which should look like the following: Play with the values of the Spacings. Have fun!


2

The trick is to give the GraphicsGrid the same aspect ratio as the tightly packed collection of graphics would have. GraphicsGrid[{{img, img}, {img, img}}, Spacings -> 0, AspectRatio -> 1/GoldenRatio ]


6

There is now a built-in version of an algorithm in v10.1: WordCloud. I wonder whether any of your nice algorithms introduced here had any influence on the built-in function... Individual words can be styled, annotated, rotated, etc., so I must assume that there is a polygon-intersection checking algorithm running under the hood. Would be useful to know ...


0

If you want an overall page title and a different label on each subfigure: Column[ {Text[Style["Here are all my graphs", 24, Bold, Blue]], Grid[ Partition[ Table[ ListPlot[RandomInteger[{0, 10}, 10], ImageSize -> 400, PlotLabel -> "Figure number " <> ToString[i]], {i, 9}], 3]]}, Alignment -> Center]


1

A mild refactoring of ubpdqn's code: f[n_, d_] := #*Map[{-Cos[#], -Sin[#]} &, #/d] & @ Sqrt @ Range @ n di[n_, d_, rad_] := Module[{fu, pt, grad, pg}, fu = f[n, d]; pt = MapIndexed[{Disk[#, rad], Sqrt[HoldForm @@ #2] ~Style~ Black ~Text~ #} &, fu]; grad = Reverse[{{0, 0}, ##} & @@@ Partition[fu, 2, 1]]; pg = ...


11

I appreciate that attempts should be the minimum standard. As this does not resemble the desired result, perhaps it can be a starting point. I look forward to OP attempt and other answers. f[n_, d_] := Module[{r = Range@n, a}, a = Sqrt[#]/d & /@ r; MapThread[#1 {-Cos[#2], -Sin[#2]} &, {Sqrt[r], a}]] di[n_, d_, rad_] := Module[{fu, pt, grad, pg}, ...


4

Since you are a new member I decided to help. I'll leave it to you to add the joining lines and colors. Look at Tube for the lines. Also my use of Text for the numbers means that they do not scale with distance and they are not occluded by the balls. pyr = NestList[ListCorrelate[{{0, 1}, {1, 1}} , #, {-1, 1}, 0] &, {{1}}, 3]; f1[{z_, y_, x_}] := ...


2

Using BarChart3D If you have to use BarChart3D you need to pre-process the input data to a form acceptable to BarChart3D, i.e., a list of lists of bar heights. Since your x and y values are integers you can get an array of bar heights using SparseArray: barchrtdata = SparseArray[{#, #2} -> #3 & @@@ test, Automatic, Indeterminate]; ...


2

As I understood your task, you need to switch you center of coordinates to point associated with center of mass and plot the radius-vectors in this coordinate system: r1n = {r1x[#] - rCx[#], r1y[#] - rCy[#], r1z[#] - rCz[#]} &; r2n = {r2x[#] - rCx[#], r2y[#] - rCy[#], r2z[#] - rCz[#]} &; ParametricPlot3D[{r1n[t], r2n[t]}, {t, 0, 34}, PlotStyle ...


2

There are several ways, I give it a try. One is to use ListPlot3D with option InterpolationOrder -> 0 and Filling -> Bottom. Here a slightly modified example from the documentation: square[{{imin_, imax_}, {jmin_, jmax_}}] := Table[UnitStep[i - imin, imax - i] UnitStep[j - jmin, jmax - j], {i, 0, 20}, {j, 0, 20}] and ListPlot3D[ ...


4

You can use the option PlotStyle to style each of the three parts separately: PlotStyle -> {Opacity[.6], EdgeForm[{Opacity[1], Thick, Blue}], EdgeForm[{Opacity[1], Thick, Red}]} Since the three-argument form of ParametricPlot3D produces polygons (i.e., those lines are not Lines!), you need to set the styles using EdgeForm. We get a much cleaner ...


3

Here's my best guess so far: fval = ParallelTable[ Through[{Abs, Arg}[Zeta[x + I y]]], {x, -28, +2, 0.05}, {y, -15, +15, 0.05}]; colors = Parallelize@ Apply[Function[{abs, arg}, {Mod[abs Sin[arg], 1], (2 Sin[arg]^2 - 1)^11/2 + 1/2, Cos[arg]^2}], fval, {2}]; Image[Transpose@ colors /. {\[Infinity] | _Interval | Indeterminate -> ...


5

You have a couple of options that might get your creative juice flowing: 1) Make a ListPlot songnotes = {"d5", "d5", "e5", "d5", "d5", "c5", "c5", "a4", "a4", "c5"}; timing = {1/4, 1/4, 1/4, 1/4, 1/2, 1/2, 1/2, 1/2, 1/2, 1/2}; noteletters = {"c4", "d4", "e4", "g4", "a4", "c5", "d5", "e5"} Make a substitution rule to help our gathering and sorting. I want ...


5

This is not a full answer, just some analysis of some of the problems we see here. Interpolation[tab, InterpolationOrder -> 1] should work, but it fails like this: Interpolation[tab, InterpolationOrder -> 1] Interpolation::femimq: The element mesh has insufficient quality of -2.05116*10^-13. A quality estimate below 0. may be caused by a wrong ...


1

Some manual analyse first. (Currently I failed to think out a way to analyse this with Mathematica.) The envelope shows the region that the family of planes occupies, so if we can decide whether a point in space belongs to the family or not, we can draw the envelope. How to decide? We change the form of the equation a little: $$ (a+x)^2+(b+y)^2=x^2+y^2+z $$ ...


0

car = Graphics[{Scale[{RGBColor[0.25, 0.63, 0.85], Polygon[... Epilog -> {{Dashed, Line[{{x, 42}, {x, y}}], Line[{{20, y}, {x, y}}]}, {AbsolutePointSize[32], Inset[car, {x, y}]}}


2

Overlay is not so useful for precisely aligning graphics objects with respect to the coordinate system of the Graphics itself. For that, you should use Inset, or directly apply Show. A quick way to do this is by using the function plotGrid from my answer here, which is built on Inset. To make it work, we have to adjust the PlotRange for each of the plots ...


6

A couple of ideas. Rendering is a problem with transparency and so many planes. Hence the need for "DepthPeelingLayers". {zsol} = Solve[2 a x + 2 b y - z + a^2 + b^2 == 0, {z}]; family = Graphics3D[ {Opacity[0.3], Darker@Red, Specularity[White, 10], EdgeForm[Directive[Opacity[0.25], Red]], Table[InfinitePlane[{x, y, z} /. zsol /. Thread[{x, y} ...


1

The official list of defined Symbols is here: http://reference.wolfram.com/language/guide/AlphabeticalListing.html You can find the usage message for all System` Symbols that have one with: msg = MakeExpression@# /. _[x_] :> MessageName[x, "usage"] &; Cases[msg /@ Names["System`*"], _String] Warning: it is slow.


1

If you want a list of all built-in commands, just type: Names["System`*"] If you want all the information of them: Information/@Names["System`*"]


4

Changing the length of the FrameTicks, which is really what you want to do, is addressed in the first "FrameTicks Styling" example of the Scope section in the FrameTicks documentation. You need to specify the actual tick values shown, like this. frame2 = Plot[Sin[x], {x, 0, 10}, Frame -> True, FrameTicks -> {{{#, #, {0.05, 0}} & /@ Range[-2, ...


0

Flatten @ Names[#] & /@ (StringJoin[#, "*"] & /@ CharacterRange["A", "Z"])


0

Rewriting the code: Ysx1 = 1/.14; U1max = .5; KM1 = KM2 = 10; Yx1x2 = 2; U2max = .11; Clear[Cs] U1 = (U1max*Cs[t])/(KM1 + Cs[t]); U2 = (U2max*Cs[t])/(KM2 + Cs[t]); rgx1 = U1*Cx1[t]; rgx2 = U2*Cx2[t]; sol = ParametricNDSolve[{Cs'[t] == DL*(250 - Cs[t]) - Ysx1*rgx1, Cx1'[t] == -DL*Cx1[t] + rgx1 - Yx1x2*rgx2, Cx2'[t] == -DL*Cx2[t] + rgx2, Cs[0] == 10, ...


0

Here you go: solved[DL_] := NDSolve[{Cs'[t] == DL*(250 - Cs[t]) - Subscript[Y, sx1]*rgx1, Cx1'[t] == -DL*Cx1[t] + rgx1 - Subscript[Y, x1x2]*rgx2, Cx2'[t] == -DL*Cx2[t] + rgx2, Cs[0] == 10, Cx1[0] == 25, Cx2[0] == 7}, {Cs, Cx1, Cx2}, {t, 0, 1000}] Plot3D[Cx2[tt] /. solved[DL]], {tt, 0, 1000}, {DL, 0.01, 0.1}, PlotRange -> All] Some ...


2

Riffle+Partition to combine starts and ends. InterpolationOrder-> 0 or 1 to produce triangles: ListPlot[ Riffle[tempDrop /@ HePure, tempDrop /@ HeO2Mix] ~ Partition ~ 2, PlotStyle -> Directive[##3], Mesh -> #2, BaseStyle -> AbsolutePointSize@7, PlotRange -> {{50, 660}, {50, 350}}, ImageSize -> 1000, AxesLabel -> {"Temperature in, ...


3

You can pre-process the input data to ListPlot dt = Transpose[{tempDrop /@ HePure, tempDrop /@ HeO2Mix}]; dt2 = Join[#, {Through@{Max, Min}@#, #[[1]]}] & /@ dt; ListPlot[dt2, Joined -> True, BaseStyle -> Thick] ListPlot[dt2, Joined -> True, PlotStyle -> Directive[Thick, Blue]] Or, less conveniently, post-process the plot output ...


1

I find its useful in cases with curated data to see what Wolfram Alpha does for a similar query/function. In this case it does seem there is underlying data for public libraries in W|A, so this is possibly just an access/terminology problem. Will explore a bit further and edit this post. From MMA try: == public library <ctrl-enter> and go from ...


1

EntityValue[] gives a list of available entity types, and "PublicLibrary" is not among them. Moreover, EntityValue["PublicLibrary", "EntityCount"] returns unevaluated, whereas EntityValue["PublicSchool", "EntityCount"] returns 103959. I would conclude, therefore, that Wolfram jumped the gun with its example. Returning to this problem later, I ...


1

You can specify the setting for the option Mesh to include graphics directives: ContourPlot3D[y^2 == a*x, {x, 0, 2}, {y, -2, 2}, {a, 0.9, 5.1}, MeshFunctions -> {#3 &}, Mesh -> {Table[{a, Hue[(a - 1)/4]}, {a, 1, 5, 0.5}]}, ContourStyle -> None, BoundaryStyle -> None, BaseStyle -> Thick]


3

Like this, Epilog? With[{expr = Cos[x], x0 = 5.4}, Plot[expr, {x, -10, 10}, AxesLabel -> {Style["x-axis", 12], Style["y-axis", 12]}, ImageSize -> {650, 650}, Epilog -> {Lighter@Red, Line[{{x0, 0}, {x0, expr /. x -> x0}, {0, expr /. x -> x0}}]}] ] Or perhaps with GridLines? With[{expr = Cos[x], x0 = 5.4}, Plot[expr, {x, ...


3

You can use Show to change options in existing graphics. plot = Plot[Sin[x],{x,0,10}, AxesLabel -> {x,y}] Show[plot, AxesLabel -> {x, Sin[x]}] Modifying the actual contents is more difficult and involves examining the contents of the Graphics expression.


6

A quick one based on your phase diagram context, where bg contains the color of your 2D planes: g = Table[ParametricPlot3D[{y^2/a, y, a}, {y, -2, 2}, PlotStyle -> Hue[(a*2 - 1)/10]], {a, 1, 5, 1}]; bg = Table[ContourPlot3D[z == a, {x, -4, 6}, {y, -4, 4}, {z, .8, 5.2}, Mesh -> None, ContourStyle -> Directive[Hue[1 - (a*2 - 1)/10], Opacity[0.3]]], ...


9

A method of assembling 2d contour plots ... Show[Table[ Graphics3D@ First@Cases[ Normal@ContourPlot[y^2 == a*x, {x, 0, 2}, {y, -2, 2}, Frame -> False], Line[x_] :> {Hue[(a - 1)/4], Line[Append[#, a] & /@ x]}, Infinity], {a, 1, 5, .5}] ,PlotRange->All] ...


6

Here's one way: ContourPlot3D[y^2 == a*x, {x, 0, 2}, {y, -2, 2}, {a, 0.9, 5.1}, MeshFunctions -> {#3 &}, Mesh -> {Table[a, {a, 1, 5, 0.5}]}, ContourStyle -> None, BoundaryStyle -> None] /. GraphicsComplex[p_, g_, opts___] :> GraphicsComplex[p, g /. Line[v_] :> {Hue[((p ~Part~ v[[1]] ~Part~ 3) - 1)/4], Thick, ...


8

You can make the Locators a part of the Graphics object instead of the Manipulate: Manipulate[pts = PadRight[pts, n, RandomReal[{-1, 1}, {15, 2}]]; disp = Graphics[{Polygon[pts], PlotRange -> 1, Locator /@ pts}], {n, 5, 15, 1}, {{pts, {{0, 0}}}, Locator, Appearance -> None}] Now you'll get a disp that looks like


11

I would like to make my graphics homogeneous with my (LaTeX) document. That means that I would like to use the same font in the graphics (labels for axis etc) as the main text. I recently wrote a package, called MaTeX, to solve this exact problem. MaTeX makes it easy to compile short LaTeX snippets and embed them in Mathematica notebooks or graphics. ...


1

Slider does not allow play button but Manipulator does. This is an example and I don't know if it fits you need. Grid[{{Manipulator[Dynamic[x]], Dynamic[x]}, {Manipulator[Dynamic[y]], Dynamic[y]}, {Show[{Graphics[{EdgeForm[Black], Dynamic@Circle[{x, y}, 1]}, PlotRange -> {{-2, 2}, {-2, 2}}], Graphics[ Translate[{Opacity[0.3], ...


4

Looks fine to me, once you get your aspect ratio proper. foci = {{-3, 25}, {2, 20}}; ContourPlot[ Total[EuclideanDistance[#, {x, y}] & /@ foci], {x, -5, 5}, {y, 10, 30}, AspectRatio -> 2, Epilog -> {Black, PointSize[Large], Point@foci}] or your horizontal and vertical ranges equal: foci = {{-3, 25}, {2, 20}}; mycontplot = ContourPlot[ ...


4

This is documented behavior. The parametric forms of ArcLength, Area, and Volume take the parametrization as fundamental, and compute the area including multiple coverings. The region forms of the functions take the image as fundamental, and compute the area of the embedding into R^n. If you want the latter, you should use ParametricRegion. From the ...


3

I think you should step back and think carefully about the expression you're using. Why are you using Sin[p] to represent the height? Also, if the height is 2, then it is not 2π. expr = {Sin[t], Cos[t], p}; ParametricPlot3D[ expr, {t, 0, 2 \[Pi]}, {p, 0, 2}, AxesLabel -> (Style[#, 18, "Label", Blue] & /@ {"x", "y", "p"}) ] Area[expr, {t, 0, 2 ...


6

Let mi visualize this mistake. Instead of constant radius we will use radius that depends of p: expr = {1 + .1 p, 1 + .1 p, 1} { Sin[t], Cos[t], Sin[p]}; ParametricPlot3D[expr, {t, 0, 3 Pi/2}, {p, 0, 2 \[Pi]}] As you can see, for p limits: {0, 2Pi} you are plotting your surface twice. Try with Cos[p] and p in {0,Pi} or whatever monotonic function for ...


3

another option is to do this by changing viewPoint, ViewVertical,ViewAngle. There are lots of view point dynamic selectors, I use one I found on this thread http://forums.wolfram.com/mathgroup/archive/2009/Apr/thread.html#00504 by Alexander Elkins. The idea is to use the mouse to change the 3D until you get the position you want, then copy the values and ...


4

sp3d = With[{asz = 1, toff = 0.1}, With[{axes = Graphics3D[{Red, Arrow[Tube[{{0, 0, 0}, {asz, 0, 0}}], 0.05], Blue, Arrow[Tube[{{0, 0, 0}, {0, asz, 0}}], 0.05], Darker[Green, .8], Arrow[Tube[{{0, 0, 0}, {0, 0, asz}}], 0.05], Text["\!\(\*SubscriptBox[\(e\), \(1\)]\)", {asz + toff, 0, 0}], ...


1

Your output looks as if Mathematica fails to find the font: I have a comparable result, if I replace "Georgia" with "SomeFontThatIsNotThere" in your code, while still not quite as ugly as yours. You might check, if Georgia is available in the Font search paths collection: Format>Option Inspector…>Global Options>File Locations>Private Paths>"Fonts" ...


1

Using VectorAngle and Developer`PartitionMap: aclF[x_] := Module[{a = VectorAngle[{1, 0}, Subtract @@ x]/Pi}, {If[a >= .5, Blend[{White, Orange, Orange, Purple, Purple, White}, 2 (a - .5)], Blend[{White, Purple, Purple, Orange, Orange, White}, 2 a]], Line@x}]; Graphics[Developer`PartitionMap[aclF, #, 2, 1] & @@@ testD, Background ...


9

Most of your lines are "multipoint" and your color function doesn't support them well. You can enforce "two points lines" by doing something like this (I'm following your map code styling here): Show[Graphics[{AngleColor[#[[2]] - #[[1]]], Line[#]}] & /@ Partition[#, 2, 1] & /@ # & /@ testD, Background -> Black, ImageSize -> 800] ...


9

It really helps others reading your code if you split things up and name parts of the code. Let's start with the polynomial. polynomial[k_] := Total[x^Range[0, 20, 3]] + k x^3; and the function that finds the roots, and the function that visualizes them roots[poly_, x_] := roots[poly, x] = Through@*{Re, Im} /@ (x /. NSolve[poly, x]) frame[k_, opacity_] ...


0

A better solution for Discrete Plots We can use Point instead of ListPlot, and then vary the size as t or tt varies. We compute the sizes as follows: unitize[t_, tMin_, tMax_] := (t - tMin)/(tMax - tMin) sizeBase[u_, sizeMin_, sizeMax_] := sizeMin + (sizeMax - sizeMin)*u sizer[{t_, tMin_, tMax_}, {sizeMin_, sizeMax_, dir_}] := ...


0

A simple, not so good solution. We use special colors (the primary colors work well) to distinguish the start and endpoints. ParametricPlot version Again, thanks to the answers to ParametricPlot and PlotLegends don't seem to cooperate and How to simulate Placed in workaround for PlotLegends ParametricPlot bug? for pointing me in the right fixes for ...



Top 50 recent answers are included