Tag Info

New answers tagged

1

Your mapping is not continuous and the mesh just shows it. fun1[u_, v_] := 2 - Norm[{u, v}]*Cos[Mod[ArcTan[v, u], Pi/3, -Pi/6]] ParametricPlot3D[{u, v, fun1[u, v]}, {u, -1, 1}, {v, -1, 1}, RegionFunction -> (1.2 < fun1[#4, #5] < 1.7 &), PlotPoints -> 50]


0

ClearAll[x]; func = Sin[x]; InputField[Dynamic[func], Expression] funcplot := Plot[func, {x, 0, 2 \[Pi]}] One way is to do what MichealE2 suggested: Dynamic[ Framed[Show[{ funcplot, Graphics[{Rectangle[{0, 0}, {.1, 1}]}] }] ]] You can also reduce amout of recalculated objects by wrapping with Dynamic only the plot: Framed[ ...


1

The code from the previous question's answer seems to work just as well here with the use of SwatchLegend: Legended[GraphicsGrid[{{Graphics[box1], Graphics[box2]}}], Placed[SwatchLegend[56, {"A", "B"}, LegendLayout -> "Row"], Above]]


4

You can also use ColorCombine: When combining a color image with a grayscale image, ColorCombine creates an image of the same color space with alpha channel. f1 = With[{dt = #, max = Last@Dimensions[#]}, ColorCombine[ {Image[MapIndexed[List @@ ColorData[{"Rainbow", {1, max}}][Last@#2] &, dt,{2}]], Image[dt]}, "RGB"]] &; data = ...


4

data = RandomReal[1, {30, 30}]; ImageMultiply[LinearGradientImage[{Blue, Red}, {30, 30}], Image[data]]


3

It's a little hard to be sure this is exactly what you are looking for, but at least it's a start. First, make the gradient image: rainbowImg=Image[Colorize[Image[Rescale[Table[j, {i, 1, 100}, {j, 1, 100}]]], ColorFunction -> "Rainbow"]] Then take the data image and use it as an alpha channel to allow it to specify the brightness of the resulting ...


5

if I understand you correctly you have the plot not the data. you need to extract the data from the plot and then (as belisarius mentioned) use interpolation. Example: p = Plot[Sin[x], {x, 0, 2 \[Pi]}]; data = Cases[p, Line[{x__}] :> x, -1]; d = D[Interpolation[data][x], x]; Plot[d, {x, 1, 2 \[Pi]}]


0

An easy way to fix this I found out is not using rotated labels on the y-axis using the command: RotateLabel -> False This does not solve the bug itself though.


3

The problem seems to be the setting "DefaultPlotStyle" -> Automatic in the Method option in the plot theme: Charting`ResolvePlotTheme["Classic", ListPointPlot3D] (* {AxesStyle -> Directive[GrayLevel[0], AbsoluteThickness[0.2]], BaseStyle -> Automatic, FaceGridsStyle -> Automatic, LabelStyle -> {FontFamily -> "Times"}, Method ...


6

Both options PlotTheme -> None and PlotTheme -> "Classic" don't give the expected coloring for the points. However, you can set their color explicitly using PlotStyle -> Directive[PointSize[0.03], ColorData[1][1]]: ListPointPlot3D[ Partition[Flatten[Table[l u1 + p u2 + q u3, {l, -3, 3}, {p, -3, 3}, {q, -3, 3}]], 3], PlotRange -> {{-1, 1}, ...


1

This demo allows the user to set x- minimum and maximum. It uses Initialization and local variables x1 and x2 to store the values so when the notebook is reopened in another session the last saved inputs are still present. Panel[DynamicModule[{f = x^2 + 3, x1 = -10, x2 = 10}, Column[{ Row[{"function ", InputField[Dynamic[f]]}], Row[{"x min = ", ...


0

Are you looking for something like this: Panel[DynamicModule[{f=x^2+3}, Column[{ InputField[Dynamic[f]], Dynamic[Plot[f,{x,-10,10}]], Dynamic[With[{z=Minimize[{f, -10<=x<=10}, x]}, Row[{"Mimimum " ,z[[1]]," for ",z[[2]]}]]], Dynamic[With[{z=Maximize[{f, -10<=x<=10}, x]}, Row[{"Maximum " ,z[[1]]," for ",z[[2]]}]]] }] ]]


2

If you must use ListPlot, then perhaps you should make two or three separate plots and align them one atop the other. A better way is to use ListLogPlot, however: ListLogPlot[{data1, data2, data3}, Joined -> True, PlotMarkers -> {Automatic, 15}, PlotRange -> {0.000001, 0.8}, PlotLegends -> Placed[LineLegend[{"data1", "data2", ...


0

LegendLayout -> {"Column",2} does exactly what you wanted. Plot[{(1 - bet) 1/(2 Sqrt[bet]), Sqrt[bet], bet^(1/4), (1 - bet) 1/(4 bet^(3/4))}, {bet, 0, 1}, PlotLegends -> Placed[LineLegend[{"MR1", "MC1", "MR2", "MC2"}, LegendLayout -> {"Column", 2}], Below], AxesLabel -> {"\[Beta]", "MR,MC"}, Ticks -> {Automatic, None}]


0

You can merge the two tables in one single list of couples of points, by using a new Table function. Then you can plot the created list using ListPlot nex1 = Table[l3*10^3/4*10^14, {l3, 1, 30, 1}]; nex2 = Table[l4, {l4, 1, 30, 1}]; Table[{nex1[[i]], nex2[[i]]}, {i, 1, 30}]; ListPlot[%]


0

MMA 10.0.1 X64 Win7. Works fine. Glad it did not crash!


2

Still crashes the kernel in version 10.0.2. The reason seems to be that the points don't lie on a regular grid: The command ListVectorPlot[ Table[{{x, -y}, {-y, x}}, {x, -3, 3, 0.5}, {y, -3, 3, 0.5}], VectorPoints -> All] works, but the command ListVectorPlot[ Table[{{x, -y + 0.01*x}, {-y, x}}, {x, -3, 3, 0.5}, {y, -3, 3, 0.5}], VectorPoints -> ...


3

I will address the case of an irregular grid. There are two or three ways to produce a pretty good looking plot, through rescaling/FrameTicks or through interpolation. The ticks method involves rescaling the data. This is perhaps the easiest, but the resulting plot cannot be easily combined with other plots, since the underlying coordinates have been ...


4

DataRange seems to destroy your scaling so let's get proper frame by overlaying oryginal one: dataZ = RandomReal[{1, 5}, {10, 10}]; scaleTheDomainBy10To[bx_, by_] := Module[{data1, range, range1}, data = Flatten[Table[{x*10^(bx - 1), y*10^(by - 1), dataZ[[x, y]]}, {x, 1, 10}, {y, 1, 10}], 1]; data1 = data; data1[[;; , ;; ...


0

Case of explicit functions: ParametricPlot3D[Evaluate[Table[{ww, zz, Exp[-(ww - 0.5 zz)^2/zz^2]}, {zz, {0.2, 0.4, 0.6, 0.8, 1.0, 1.2}}]], {ww, -2, 2}, PlotStyle -> {{Black, Thick}, {Blue, Thick}, {Red, Thick}, {Yellow, Thick}, {Green, Thick}, {Magenta, Thick}}] Case of Interpolating functions: mmax = 4; tm = Table[m, ...


1

Firstly, no need to use Show, simply remove the ; from the end of your Graphics3D expressions. Secondly, try evaluating: Graphics3D[ Table[Cuboid[{{a + (l - 1) dx, 0, 0}, {a + l*dx, +.01, f[startpos[3, l]] + .01}}], {l, 1, 50, 1}], AxesLabel -> {x, y, z}, Axes -> True, BoxRatios -> 1, Ticks -> None, AxesOrigin -> {0, 0, 0}, Boxed ...


2

I would switch approach to something like: Show[ RevolutionPlot3D[2 Cos[Floor[x, (Pi/10)]], {x, 0, 9 Pi/2 + .2}, Exclusions -> None, PlotPoints -> 100, MeshStyle -> Thick], RevolutionPlot3D[0, {x, 0, 9 Pi/2}, Exclusions -> None, PlotPoints -> 50, MeshStyle -> Thick] ...


2

Edit I've included another method for creating the crystal structure which should be useful for pedagogical purposes, but assumes that MoS2 behaves ideally. Short Answer It can't be done with ChemicalData alone, (as of 2014) since there is important information missing. We are not given any information about the crystal structure, and therefore need to ...


0

Try: Ticks -> {Range[0, 7, 1], Automatic} Otherwise, I think Mathematica might be considering the point x = 2 on your graph as the origin of the , and from the Function Navigator, Possible Issues of Ticks states that it will not label the origin. Switch to Axes->{True,True} and post the screenshot. Also, removing PlotRange -> All might do the ...


3

I propose an example silhouette descriptor based on a polar histogram. In my example histogram consits of 36 bins. newBinCounts funtion newBinCounts[angles_, bins_] := Module[{hist, sectorIndex}, ( hist = BinCounts[angles, {bins}]; sectorIndex = Table[Flatten[ Union[Position[angles, #] & /@ ...


4

you can use Method -> {"FrameInFront" -> False}] option. labels = Transpose@{Range@4, {"a", "b", "c", "d"}}; ArrayPlot[RandomInteger[1, {4, 4}], Mesh -> True, Frame -> True, PlotRangePadding -> None, FrameTicks -> {{labels, labels}, {labels, labels}}, Method -> {"FrameInFront" -> False}]


4

Look for details on "Ticks" in help, each tick can be defined by {x, label, len, style} - len defines the outer and inner length of the tick, so in your case just add 0 to each tick specs: labels = Transpose@{Range@4, {"a", "b", "c", "d"}, 0 Range[4]}; and here you go:


1

ContourLabels displaying any quantity you wish can be created with an option of the sort, ContourLabels -> (Text[Framed[#3^2], {#1, #2}, Background -> White] &). In this case, it creates labels displaying the square of the contour value, but #3^2 can be replaced by any desired expression involving #3, the value of the plotted function. For ...


1

This is just an extended comment. The corners that you used to define the Cuboid do not define a valid region. While Cuboid[{2, -2, -1}, {-2, 2, 3}] and Cuboid[{-2, -2, -1}, {2, 2, 3}] fill the same space, Mathematica only considers the second Cuboid to be a valid region. RegionQ /@ { Cuboid[{2, -2, -1}, {-2, 2, 3}], Cuboid[{-2, -2, -1}, {2, 2, 3}]} ...


2

p2 = Animate[Show[{ RegionPlot3D[ And[-2 < x < 2, -2 < y < 2, -1 < z < 3, z - t y - t x < 0], {x, -4, 4}, {y, -4, 4}, {z, -4, 4} ], ContourPlot3D[{z - t y - t x == 0}, {x, -3, 3}, {y, -3, 3}, {z, -7, 7}, MeshFunctions -> {Function[{x, y, z, f}, x^2 + y^2 - r^2 - z + t y + t x]}, Mesh ...


1

Even just setting PlotMarkers->Automatic makes the error bars disappear Fixed in 10.0.2. windows 7, 64 bit Needs["ErrorBarPlots`"] ErrorListPlot[{{{1, 1}, ErrorBar[0.2]}, {{2, 2}, ErrorBar[0.1]}, {{3, 4}, ErrorBar[0.3]}, {{4, 6}, ErrorBar[0.4]}, {{5, 7}, ErrorBar[0.8]}, {{6, 10}, ErrorBar[0.5]}}, Joined -> True] ErrorListPlot[{{{1, ...


0

I believe this one is simple enough: Plot[{bet, bet^2, bet^3, bet^4}, {bet, 0, 1}, PlotLegends -> Placed[{"MR1", "MC1", "MR2", "MC2"}, Below]] /. "Row" :> (Grid[Apply[Sequence, Partition[#, 2], {2}]] &) Edit: Here you can see how you can reorder the legends easily Plot[{bet, bet^2, bet^3, bet^4}, {bet, 0, 1}, PlotLegends -> ...


0

Plot[{(1 - bet) 1/(2 Sqrt[bet]), Sqrt[bet], bet^(1/4), (1 - bet) 1/(4 bet^(3/4))}, {bet, 0, 1}, PlotLegends -> Placed[LineLegend[ ColorData[97, "ColorList"][[{1, 2, 3, 4}]], {"MR1 lorem ipsum", "MC1 lorem ipsum", "MR2 lorem ipsum", "MC2 lorem ipsum"}[[{1, 2, 3, 4}]], LegendLayout -> (Grid@Transpose@Partition[Row /@ #, 2] ...


8

[Edited to correct the bin definition.] You could use SectorChart. The trick is to ensure that your bin widths sum to 360° and that the first bin charted starts at zero. Firstly, and borrowing shamelessly from @george2079's answer [and subsequent correction], define the bins: bins = Table[a , {a, -180, 180, 30}]; Next create the sector chart data: ...


1

For example: solx = NDSolve[{x''[t] == -x[t], x[0] == 0, x'[0] == 1}, x, {t, 0, 2 Pi}] soly = NDSolve[{y''[t] == -y[t], y[0] == 2, y'[0] == 1}, y, {t, 0, 2 Pi}] ParametricPlot[{x[t] /. solx[[1]], y[t] /. soly[[1]]}, {t, 0, 2 Pi}]


8

data = RandomReal[ {0, 200}, {200, 2}]; center = {50, 50}; centereddata = (# - center) & /@ data; angles = N[ArcTan[#[[1]], #[[2]]]/Degree] & /@ centereddata; radiis = N@Sqrt[#[[1]]^2 + #[[2]]^2] & /@ centereddata; note you need to use Degree to put the angles back to radians here.. polardata = Transpose[Join[{angles Degree}, {radiis}]]; ...


1

As you state in the comment section, this has been fixed with the version 10.0.1. GeoRegionValuePlot[{GeoDisk[GeoPosition[{48, 5}], 100000] -> 3.4, GeoDisk[GeoPosition[{49, 6}], 200000] -> 5.4}, PlotStyle -> Opacity[0.4], Frame -> True]


0

Plot[y /. Solve[y^3 + 2 == Sqrt[x^2 + x + 1], y], {x, -10,10}]


4

According to the documentation: Unless an explicit Return is used, the value returned by Do is Null In other words, unless you create a side effect by assigning something to some expression name, e.g. using Set (=), Do doesn't "do" anything. It evaluates expressions but does not return them. As mentioned in comments, there are many alternative - and ...


1

As @YvesKlett suggested, I have sorted it out! x1 = Range[0, 10, 2]; y1 = Sin[x1]; ListLinePlot[ Thread[{x1, y1}], FrameTicks -> { {Automatic, Automatic}, {Thread[{x1, Exp[x1] // N}], x1} }, Mesh -> Full, Frame -> True] FrameTicks does the trick!


2

It seems there's a problem when mathematica renders the output image in some cases: Thats label for 18-22 font sizes, evidently it doesn't smoothly work for 19, 20, 21. But since you increase the quality - everthing becomes perfect: Rasterize[ListPlot[{{1, 2}}, FrameLabel -> {"", "Probability of extinction!"}, Frame -> True, FrameStyle -> ...


4

dt = RandomInteger[10, 10]; The following reproduces the issue (Version 9.0.1.0 Windows 8 64bit) with large enough font size for the frame labels: lp1 = ListPlot[dt, ImageSize -> 400, Frame -> {True, True, False, False}, FrameLabel -> {None, Style["Probability of extinction", 16], None, None}] You can wrap the labels with Framed or Pane ...


0

I believe this is a duplicate of this question, and that the answer is to include BaseStyle -> {PrivateFontOptions -> {"OperatorSubstitution" ->False}}. However, be aware of some issues, and (on v10) this change of syntax. If this solves your issue, I will link the questions by marking yours as a duplicate.


1

Manipulate[ Plot[ {-3.56 + 2.222 y - .22 y^2, 1/(.05 \[Sqrt]y) - c}, {y, 0, 10}, PlotRange -> {{0, 10}, {0, 5}}, PlotStyle -> {Blue, Orange}, Filling -> {1 -> {{2}, {None, Yellow}}}], {{c, 5.8, "Use of Resources"}, 5.8, 6.93}]


1

Here is a look at the color channel value mapping to the raster output: data = RandomReal[{0, 1}, {50, 50}]; mp = MatrixPlot[data, Mesh -> True, Frame -> False, ColorFunctionScaling -> True]; (out = Reverse[Cases[mp, _Raster, Infinity][[1, 1]]]); GraphicsRow@(ListPlot[ Transpose[{ Flatten[data], # }]] & /@ ...


2

A terser way to use Graphics[] arguments: pts = {{19.4, 12.4, 6.2}, {15.9, 4.6, 12}, {18.64, 10.52, 7.51}, {20.3, 3.1, 4.1}}; cols = {Green, Blue, Orange, Purple}; Manipulate[ Graphics3D[{Opacity[.1], Sphere[{18.64, 10.52, 7.51}, 2.93], Opacity[.5], AbsolutePointSize[6], Thread[{cols, Point /@ pts}]}, PlotRange -> If[fixedPltRng, {{-20, 20}, ...


2

Opacity should be in the range 0-1, and the elements must be in a list of elements: Manipulate[ Graphics3D[{ {Opacity[.1], Sphere[{18.64, 10.52, 7.51}, 2.93]}, {Opacity[.5], Green, AbsolutePointSize[6], Point[{19.4, 12.4, 6.2}]}, {Opacity[.5], Blue, AbsolutePointSize[6], Point[{15.9, 4.6, 12}]}, {Opacity[.5], Orange, AbsolutePointSize[6], ...


2

To get the right view point, one needs -∞ in place of ∞. And just to be safe, I would set ViewVertical explicitly and use Deploy to prevent manual/mouse rotation of the graphics. list1 = {{1, 1, 1}, {1, 2, 2}, {1, 3, 1}, {1, 4, 2}, {2, 1, 1}, {2, 2, 1}, {2, 3, 3}, {2, 4, 3}, {3, 1, 1}, {3, 2, 2}, {3, 3, 3}, {3, 4, 4}}; ...


0

Your Input gsols=Table[...] may be labeled with TraditionalForm (or any other cell). If you now set the cell back to StandardForm the output should be accordingly. Not sure about the removing of the TraditionalForm wrapping at output... otherwise start your calcs in a fresh notebook an avoid TraditionalForm.


1

t = Table[{i, Cos[i], Sin[i]}, {i, 0, 20, .1}]; f[l_, v_] := (v #) & /@ l ListPointPlot3D[{t, f[t, {1, 1, 0} ], f[t, {1, 0, 1} ], f[t, {0, 1, 1} ]}, Filling -> Axis] GraphicsRow[ListPointPlot3D[{t, f[t, # ]}] & /@ Permutations[{1, 1, 0}]]



Top 50 recent answers are included