Tag Info

New answers tagged

2

It seems AxesOrigin property spoils everything. A bug maybe.. I can suggest 2 way outs: first, simply: Graphics3D[{arrowAxes[3], Sphere[{1, 1, 1}]}, Axes -> True, Boxed -> False, AxesEdge -> {{0, -1}, {0, -1}, {0, -1}}, AxesStyle -> Opacity[0], TicksStyle -> Opacity[1]] This gives what you want, but i don't know how to specify the ...


1

I just changed your code a little bit, to TickStyle->None arrowAxes[arrowLength_] := Map[{Apply[RGBColor, #], Arrow[Tube[{{0, 0, 0}, #}]]} &, arrowLength IdentityMatrix[3]]; Graphics3D[{Sphere[{1, 1, 1}], arrowAxes[3]}, Axes -> True, Boxed -> False, AxesOrigin -> {0, 0, 0}, AxesStyle -> Opacity[0], TicksStyle -> None]


2

It seems you need more points, not recursion. If you increase the number of PlotPoints and add PerformanceGoal -> "Quality", the wiggles disappear! bicone = ParametricPlot3D[{(1 - Abs[z]) Cos[t], (1 - Abs[z]) Sin[t], z}, {z, -1, 1}, {t, 0, 2 \[Pi]}, Mesh -> None, Boxed -> False, Axes -> None, PlotStyle -> {Specularity[White, 15], ...


7

Here's a way to get the plane of best fit: subtract the centroid of the data, and then plot the plane generated by the first two left singular vectors of the singular value decomposition of the resulting data: Y = # - Mean /@ # &[t1\[Transpose]] {U, S, V} = SingularValueDecomposition[Y]; Graphics3D[{InfinitePlane[{{0, 0, 0}, U[[;; , 1]], U[[;; , 2]]}], ...


5

Show[ ListPointPlot3D[t1, PlotStyle -> Red, Filling -> Bottom], Plot3D[ Evaluate@Fit[t1, {1, x, y}, {x, y}] , {x, Min[t1[[All, 1]]], Max[t1[[All, 1]]]} , {y, Min[t1[[All, 2]]], Max[t1[[All, 2]]]} ]]


2

I changed your probabilities a bit to make them better match your sphere specification, and to get a more interesting color pattern, but you'll get the idea: probs = Table[1/84 Exp[-i*j*1.0/9000], {i, 1, 30}, {j, 1, 10}]; minprob = Min@probs; maxprob = Max@probs; probsScaled = Rescale[probs, {minprob, maxprob}, {0, 1}]; colors = ...


2

colors = Hue[100 #] & /@ Table[1/84 Exp[-i*i*1.0/9000], {i, 1, 300}]; spheres = Sphere[#, 2] & /@ Chop[Flatten[Table[R[i, j], {i, 1, 30}, {j, 1, 10}], 1]]; Graphics3D[Thread[{colors, spheres}]]


1

Using J.M.'s implementation of polyharmonic splines: points = {1, 1, 0.2} # & /@ Select[RandomReal[{-1, 1}, {20, 3}], f @@ Most@# > 0 &]; f[x_, y_] := 1 - x^2 - y^2 pointsByF = ({1, 1, 1/f @@ Most@#} # &) /@ points; zByF[x_, y_] := Evaluate@polyharmonicSpline[pointsByF, {x, y}]; z[x_, y_] := f[x, y] zByF[x, y] Show[Plot3D[z[x, y], {x, -1, ...


4

Why do it this way? Well, (1) for fun and (2) because Mathematica can. There are infinitely many ways to interpolate a boundary and interior points. One way is to use the FEM functionality to do so. It might be the look the OP wants after all - who knows? :) We can create an element mesh containing the bounding curve and the xy locations of the ...


2

If the mesh lines are not needed, SphericalPlot can be used in a much simpler form: sp1 = SphericalPlot3D[1, {θ, 0, π}, {ϕ, 0, 2 π}, Mesh -> {1, 2}, MeshShading->Thread[{{Red, Blue, Yellow}, Green}], MeshStyle->None, Lighting->"Neutral"] If you do need the mesh lines, you can do sp2 = SphericalPlot3D[1, {θ, 0, π/2}, {ϕ, 0, 2 π}, ...


5

Show[SphericalPlot3D[1, ##, Mesh -> None] & @@@ MapThread[{{s, Sequence @@ #1}, {t, Sequence @@ #2}, PlotStyle -> #3} &, {{{0, \[Pi]/2}, {0, \[Pi]/2}, {0, \[Pi]/ 2}, {\[Pi]/2, \[Pi]}}, {{0, (2 \[Pi])/3}, {(2 \[Pi])/3, ( 4 \[Pi])/3}, {(4 \[Pi])/3, 2 \[Pi]}, {0, 2 \[Pi]}}, {Red, Green, Blue, Yellow}}], PlotRange -> ...


8

1. The normal mesh functions are u (#4 &) and v (#5 &). So we can just use Mesh without special mesh functions. ParametricPlot3D[{Cos[u] Sin[v], Sin[v] Sin[u], Cos[v]}, {u, 0, 2 Pi}, {v, 0, Pi}, Mesh -> {{0, 2 Pi/3, 4 Pi/3}, {Pi/2}}, MeshShading -> Map[Directive[Opacity[0.6], #] &, {{Red, Green, Blue}, {Yellow, Yellow, Yellow}}, ...


10

Probably not that useful, but it turned out looking cool. temp[x_, y_, z_] := 10000 Exp[-Sqrt[4 + (z - 5)^2]/50]*40/(40 + x^2 + y^2); Graphics3D[{Opacity[0.5], Raster3D[ Table[Append[List @@ ColorData["BlackBodySpectrum"][#], Clip[(# - 6000) (10000 - #)^2/2.5*^10]] &@ temp[x, y, z], {x, -5, 5, 1/2}, {y, -5, 5, 1/2}, {z, 0, 30, 1/2}]] ...


4

Firstly to use BSplineSurface an array of control points is required, in your case: Graphics3D[BSplineSurface[Partition[icir, 2]]] As Öskå commented you can simply use ListPlot3D[icir]. The RegionFunction option will limit the surface to a given region (see below) but your example points all fall within the unit circle so you won't see a circular ...


1

Here is a way of getting Mathematica’s 3D graphics into COLLADA format — e.g. for importing into iBooks Author on OS X — whilst preserving colour information. Unfortunately, this involves a manual intermediate step using Blender, but it is the only way that I have found that automatically preserves colour. The trick is to use the fact that Blender can ...


-1

Sorry, I somehow have two accounts one on my computer the other my phone. I can't edit or comment, so I reply with this update for you: Actually, I am supposed to use cylindrical coordinates if needed. Also could you not use Integrate[ h(x,y,z,),(x,x_o,x_f},{y,..... Hand typed so it isn't exact.


5

By adding axes labels to your plot we can see that the base of the cone is not in the zy plane as requested. You need to rework your inequality so that the radius is proportional to the distance from origo along the x-axis, i.e. $z^2+y^2\leq x^2$. RegionPlot3D[ (y^2 + z^2)^(1/2) <= x && 0 <= x <= 5, {x, 0, 5}, {y, -5, 5}, {z, -5, 5}, ...


9

You could use an image representation of the plot and map it onto the modified cylinder that I defined in the answer linked here. Just copy the definition of cyl from that answer, which includes the ability to add textures as follows: img = Image@StreamPlot[{y, -Sin[x]}, {x, -5, 5}, {y, -3, 3}, Frame -> None, PlotRange -> {{-5, 5}, {-3, 3}}, ...


15

plot = StreamPlot[{y, -Sin[x]}, {x, -Pi, Pi}, {y, -3, 3}, Frame -> None, Epilog -> {PointSize -> Large, Point[{{0, 0}, {π, 0}, {-π, 0}}]}, StreamPoints -> Fine, AspectRatio -> 0.8] Try this: First[Normal@plot] /. a_Arrow :> ( a /. {x_Real, y_Real} :> {Cos[x], Sin[x], y} ...


6

I changed tri to List of your code. d = 9; x = {}; For[t = 1, t <= d, t++, If[t < d, AppendTo[x, {t, 1, 1} <-> {t + 1, 1, 1}]]; For[r = 2, r <= d, r++, If[t < d, AppendTo[x, {t, r, 1} <-> {t + 1, r, 1}]]; For[i = 2, i <= r, i++, If[t < d, AppendTo[x, {t, r, i} <-> {t + 1, r, i}]]; AppendTo[x, {t, r, i - 1} ...


5

Use the Region functions in version 10 Update: Cube punctured by cylinder Let's tackle the first issue, the cube punctured by the cylinder. It's a matter of subtracting their regions. (*Find the region of the solid cube *) R5 = Cuboid[]; CubeRegion = ImplicitRegion[RegionMember[R5, {x, y, z}], {x, y, z}] cubePlot = RegionPlot3D[CubeRegion, PlotPoints ...


2

Perhaps Reduce may be easier to work with: soln = Reduce[(n^2 + x^4)/(4 x^2) == z && 0 < n < 101 && 0 < x < 101 && 0 < z < 101111, {n, x, z}, Integers] /. Or | And -> List {{z == 2, n == 4, x == 2}, {z == 5, n == 8, x == 2}, {z == 5, n == 8, x == 4}, {z == 8, n == 16, x == 4}, {z == 10, n == 12, x == ...



Top 50 recent answers are included