Tag Info

Hot answers tagged

15

A crude attempt This is for Mathematica 10+ only. To construct each face, I use an intersection between a unit 3-ball centred at the origin and a pyramid whose base is at infinity and apex is at the origin. Each edge of the pyramid passes through each vertex of the spherical face. The pyramid is given by ConicHullRegion[{origin}, {vertices}]. The ...


13

Using the same initialization code as Taiki: origin = {0, 0, 0}; points = {{-0.9207, -0.3896, 0.0091}, {-0.8272, 0.5077, -0.2399}, {0.2544, -0.3511, 0.901}, {0.351, 0.6527, 0.6712}, {0.5436, -0.6326, -0.5513}, {0.6016, 0.2317, -0.7643}}; fs = {{1, 3, 5}, {1, 2, 4, 3}, {1, 2, 6, 5}, {3, 4, 6, 5}, {2, 4, 6}}; faces = points[[#]] & /@ fs; Then ...


12

Let me use this as example data instead (your m is too big): m = RandomReal[1, {4, 24}]; Crude Attempt polararrayplot[array_, colourfunc_] := SectorChart[ Map[Style[{1, 1}, colourfunc[#]] &, array, {2}], SectorSpacing -> None ]; polararrayplot[m, ColorData["Rainbow", #] &] Finer Attempt The code is fairly self-explanatory. I'm sure ...


12

$(x^2+y^2-1)^2+(y^2+z^2-1)^2+(x^2+z^2-1)^2=0$ is satisfied by a set of points. This can be established: f = (x^2 + y^2 - 1)^2 + (y^2 + z^2 - 1)^2 + (x^2 + z^2 - 1)^2; FullSimplify[Reduce[f == 0, {x, y, z}, Reals]] Reduce[x^2 + y^2 == 1 && z^2 + y^2 == 1 && x^2 + z^2 == 1, {x, y, z}] i.e. (x == -(1/Sqrt[2]) || x == 1/Sqrt[2]) && ...


11

What about some 2D Geo functionality for this? points = {{-0.9207, -0.3896, 0.0091}, {-0.8272, 0.5077, -0.2399}, {0.2544, -0.3511, 0.9010}, {0.3510, 0.6527, 0.6712}, {0.5436, -0.6326, -0.5513}, {0.6016, 0.2317, -0.7643}}; edges = {{1, 2}, {1, 3}, {1, 5}, {2, 4}, {2, 6}, {3, 4}, {3, 5}, {4, 6}, {5, 6}}; Construct the geodesics as GeoPath objects: latlons ...


11

Let me add another answer. This code is much shorter and faster than my previous one, and the resulting mesh of each face is much cleaner. The procedure is simple. Triangles are first made from the given face vertices and discretised. Each mesh point is then pushed onto a 2-sphere while its angular positions are maintained. points = { {-0.9207, -0.3896, ...


9

I believe the symbolic evaluation occurs as part of exclusions detection. If you evaluate the plot with Exclusions -> None the symbolic evaluation doesn't occur. I suppose when you use a function which returns a non-numeric result such as Null, the system skips the exclusions detection altogether.


8

I think this is what you mean: Plot3D[Φ, {x, y} ∈ RegionDifference[DiscretizeRegion@Ω, ConvexHullMesh[circle[[All, 1 ;; 2]]]], PlotStyle -> None, PlotTheme -> "Detailed", Mesh -> {25}, AxesLabel -> {"x", "y", "ϕ(x,y)"}, LabelStyle -> Directive[FontFamily -> "Courier New"]] But perhaps I subtracted them in the wrong order, ...


8

Perhaps a bit more elegant than Sjoerd's approach: data = Sort @ data; (* address Sjoerd's concern *) pts = { data, MinimalBy[data, Last, 1], MaximalBy[data, Last, 1] }; DateListPlot[pts, Joined -> {True, False, False}, PlotStyle -> {Automatic, Red, Green} ]


7

A quick and dirty way to do this is to pad the image with pixels of some inoffensive color, so that the actual meaningful part of the image gets mapped to a smaller portion of the sphere: image = Import["ExampleData/ocelot.jpg"]; {width, height} = ImageMeasurements[image, "Dimensions"]; image = ImagePad[image, {{2 width, 2 width}, {height, height}}, White]; ...


6

An FEM element-meshing approach. The quality is controlled by the option "MaxCellMeasure" -> {"Length" -> 0.05}. Note that the VertexNormals -> -coords option causes the polygonal sphere to be smoothed out when displayed on the screen. Needs["NDSolve`FEM`"]; points = {{-0.9207, -0.3896, 0.0091}, {-0.8272, 0.5077, -0.2399}, {0.2544, -0.3511, ...


6

ContourPlot3D seems to do it f = (x^2 + y^2 - 1)^2 + (y^2 + z^2 - 1)^2 + (x^2 + z^2 - 1)^2; ContourPlot3D[f, {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, ContourStyle -> Opacity[1], Mesh -> None, Contours -> {1}] There are many other options you can try for this command. You can change the Contours and Opacity, Mesh, etc.. update: Answer for ...


6

Based on your code, we can first create a function PoAGen to generate mean PoA values as follows: Clear[PoAGen] PoAGen[nodes_, links_, n_: 1000] := Module[ {an = 10, al = 1, s, M, id, od, wd, x, poa, PoA}, Cases[_?NumericQ]@ Table[s = DirectedGraph[RandomGraph[{nodes, links}], "Acyclic"]; M = al*Transpose[AdjacencyMatrix[s]]; id = an + ...


6

Update: SeedRandom[123] d1 = BinormalDistribution[.75]; r = RandomVariate[d1, 20]; hg = Histogram3D[r, Automatic, "PDF", ChartStyle -> Opacity[.35]]; sh = SmoothHistogram3D[r, Automatic, "PDF", BoundaryStyle -> None, PlotStyle -> None, Mesh -> {{{.03, Directive[Thick, Orange]}, {.11, Directive[Thick, Red]}}}]; Row[{Show[hg, sh, PlotRange ...


5

triples = Table[{0, RandomInteger[5], RandomReal[]}, {5}]; (* {{0,4,0.676806},{0,5,0.377882},{0,2,0.421773},{0,4,0.631164},{0,3, 0.820832}} *) opts = {Axes -> True, PlotRange -> {{-1, 1}, {0, 6}}, Frame -> False, ImageSize -> 150, AspectRatio -> Automatic, BaseStyle -> Thick}; Graphics g1 = Graphics[{Hue[RandomReal[]], Circle[{#, ...


5

Plot[{11 + x, 27 - x, 1/5 (90 - 2 x), Min[11 + x, 27 - x], Min[11 + x, 27 - x, 1/5 (90 - 2 x)]}, {x, 0, 20}, Filling -> {5 -> {Axis, {White, LightBlue}}, 4 -> {{3}, {None, Yellow}}}]


5

r = ImplicitRegion[ y <= 11 + x && y <= 27 - x && y <= 1/5 (90 - 2 x) && x >= 0 && y >= 0, {x, y}]; Show[Plot[{11 + x, 27 - x, 1/5 (90 - 2 x)}, {x, 0, 20}, AxesOrigin -> {0, 0}], RegionPlot[r]]


5

One way is through a bilogarithmic plot. Define bilog[val_, cut_: 1., ff_: .25] := Module[ {out}, out = If[Abs[val] <= cut, ff val, Sign[val] Log10[Abs[val]] ] ]; for the data and blvs[{rl_, rh_}, cut_: 1] := Module[ {out, lin, lgn, lgp, lgt, lgm, lgo, tik, tkn, tkp}, lin = Range[-.9 cut, .9 cut, cut/10]; lgp = ...


5

It is not clear how you want the filling done. Here is one filling. f[x_] := x f2[x_] := x - (1/6) f3[x_] := x + (1/6) line1 = Line[{{10, 0}, {10, 10}}]; line2 = Line[{{0, 10}, {10, 10}}]; line3 = Line[{{9, 9}, {10, 9}}]; lineStyle = {Thick, Black, Dashed}; Plot[{f[x], f2[x], f3[x]}, {x, 9, 10}, Epilog -> {Directive[lineStyle], line1, line2, line3}, ...


5

You might be having a problem with AxesOrigin being off the plot. We can force this to happen by specifying both AxesOrigin and PlotRange: Plot[x^2, {x, 0, 1}, AxesOrigin -> {-1, 0}, PlotRange -> {{0, 1}, {0, 1}}] If setting PlotRange -> All or PlotRange -> Full doesn't do the trick, you can manually specify the origin using: AxesOrigin ...


5

I would use Epilog option to add the desired annotations. Further, because the annotations are somewhat complex, I would write a function to generate an annotation and map it over the POI list to produce the full set of annotations. Also, some attention must be given to padding the plot at the bottom so the annotations will be visible. annotation[x_, y0_, ...


4

I created this function to convert from cylindrical to cartesian: thing[r_, theta_, z_] := {r Cos[theta], r Sin[theta], z} Then use ParametricPlot3D ParametricPlot3D[thing[Exp[t], t + 1, Exp[2 t]], {t, 0, 1}]


4

According to the comment below your question I believe this does what you want: scale = Sign[#] Log[1 + Abs@#] &; invscale = Sign[#] (Exp[Abs@#] - 1) &; ListLinePlot[ llvaluefull, ScalingFunctions -> {{scale, invscale}, Identity} ] ScalingFunctions works in ListLinePlot in Mathematica 10.0.2, but it is not officially supported. It may ...


4

More or less a duplicate of this answer, but just to demonstrate how it is used: Some data: d1 = RandomVariate[NormalDistribution[0, 1], 200]; d2 = RandomVariate[NormalDistribution[0, 1], 1000]; Create the individual plots and then combine them using Overlay optsall = {Axes -> False, Frame -> True, ImageSize -> 600, BaseStyle -> {Thick, ...


4

Using the option Exclusions->None fixes the issue in both plots: ContourPlot[L, {x, 0, xmax}, {y, 0, ymax + 1}, Contours -> 50, ColorFunction -> Function[{x, y, z}, Hue[x]], Exclusions -> None] Plot3D[L, {x, 0, xmax}, {y, 0, ymax + 1}, ColorFunction -> Function[{x, y, z}, Hue[z]], Mesh -> None, ClippingStyle -> {Blue, Red}, ...


4

In Comments above, the OP requested that values be displayed only for mesh points. This can be accomplished as follows, using Annotation. Show[ParametricPlot[{Cos[u]^v, u}, {v, 0, 1}, {u, 0, Pi/2}, Mesh -> {5, 5}, FrameLabel -> {Cos[u]^v, u}], ListPlot[Quiet@Table[Annotation[{Cos[u]^v, u}, {N[v], N[u]}, "Mouse"], {v, 0, 1, ...


4

One can get a sort of array plot with ParametricPlot, MeshShading and an appropriate Mesh that seems equivalent to the Matlab plot: n = 20; r = Range[40.]/20; theta = Pi Range[40.]/20; m = Table[r1 Cos[2. theta1], {theta1, theta}, {r1, r}]; colorFn = ColorData["Rainbow"]; ParametricPlot[r {Cos[t], Sin[t]}, {r, 0, 1}, {t, 0, 2 Pi}, Mesh -> ...


4

Eb = 2 10^7; b = 1/4; t0 = 1/2; L = 5; t[x_] := (t0 (L + x))/L; s = DSolve[{Eb (b t[x]^3)/12 y''''[x] == -1, y''[0] == 0, y''[L] == 0, y[0] == 0, y[L] == 0}, y, x][[1]]; displacement = y[x] /. s[[1]]; u = {-x2 D[displacement, x], displacement}; VectorPlot[u, {x, 0, L}, {x2, -4, 4}]


4

Here's a simple way to enumerate all the conditions: fs = {x, y, z, 0}; conds = Table[{Equal @@ fs1, And @@ Table[First@fs1 >= f, {f, Complement[fs, fs1]}]}, {fs1, Subsets[fs, {2}]}] (* {{x == y, x >= 0 && x >= z}, {x == z, x >= 0 && x >= y}, {x == 0, x >= y && x >= z}, {y == ...


4

Also Plot[{9, 10, f1[x], f2[x], f3[x]}, {x, 9, 10}, Epilog -> {Directive[lineStyle], line1, line2, line3}, Filling -> {{5 -> {{2}, {Blue, Green}}}, {4 -> {{1}, {Red, Orange}}}}, BaseStyle -> Thick]



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