Tag Info

Hot answers tagged

15

To long for a comment, but here's one approach, using information readily available in the docs and on this site: First, make a map that wraps a globe changing the Geoprojection to something a bit more useful. img = With[{Δ = 30}, Row[Table[ GeoGraphics[GeoBackground -> GeoStyling["ReliefMap"], GeoRange -> {{-90, 90}, {λ, λ + Δ}}, ...


11

Using Composition I can apply RotationTransform, TranslationTransform , ShearingTransform one after the other. Graphics3D[{ Opacity[1] , Red , Arrow[{{0, 0, 0}, {1, 0, 0}}] , Green , Arrow[{{0, 0, 0}, {0, 1, 0}}] , Blue , Arrow[{{0, 0, 0}, {0, 0, 1}}] , Opacity[0.2] , GeometricTransformation[Cuboid[-{1, 1, 1}/4, {1, 1, 1}/4], ...


8

Mathematica should render the secondary structure in the usual way when you import pdb files. I dont know why this doesn't work with the example you provided. I thought there might be a size limit for the protein but I managed to import much bigger proteins such as 1YHU and they got rendered without problems... strange. ...


7

Here is how it works. If you have a volume in 3d it is essential, that you use connected component labeling in 3d so that components that are connected over layers stick together and get the same label. Lucky for us that MorphologicalComponents can do this. Let's create a test volume data = With[{init = RandomChoice[{0, 0, 1}, {10, 10}]}, NestList[ ...


6

You can set Texture before each polygon t = ImageResize[ExampleData@#, {100, 100}] & /@ ExampleData["ColorTexture"][[;; 6]]; vtc = {{0, 0}, {1, 0}, {1, 1}, {0, 1}}; coords = {{{0, 0, 0}, {0, 1, 0}, {1, 1, 0}, {1, 0, 0}}, {{0, 0, 0}, {1, 0, 0}, {1, 0, 1}, {0, 0, 1}}, {{1, 0, 0}, {1, 1, 0}, {1, 1, 1}, {1, 0, 1}}, {{1, 1, 0}, {0, 1, 0}, ...


6

Using ComponentMeasurements twice, on the original matrix m and on Transpose/@m we can get all Neighbors: mat = RandomInteger[{0, 1}, {3, 3, 3}]; m = Module[{i = 1}, mat /. 1 :> i++]; v = ComponentMeasurements[m, "Label"][[All, 1]] (*{1,2,3,4,5,6,7,8,9,10,11,12,13,14}*) vcoords = ComponentMeasurements[m, "Centroid"][[All, -1]] ...


5

For a starter Manipulate[Graphics3D[{EdgeForm[None], Opacity[.3], Green, poly = Polygon[.5 {{-1, -1, 0}, {-1, 1, 0}, {1, 1, 0}, {1, -1, 0}}], Polygon[.5 {{-1, 0, -1}, {-1, 0, 1}, {1, 0, 1}, {1, 0, -1}}], Polygon[.5 {{0, -1, -1}, {0, -1, 1}, {0, 1, 1}, {0, 1, -1}}], EdgeForm[None], Opacity[0.7], {Red, GeometricTransformation[poly, ...


5

VectorPlot3D[{x, y, z}, {x, -1, 1}, {y, -1, 1}, {z, -1, 1}] Now you can either use ViewPoint VectorPlot3D[{x, y, z}, {x, -1, 1}, {y, -1, 1}, {z, -1, 1}, ViewPoint -> {0, 0, 200}] or define a very small z-range VectorPlot3D[{x, y, z}, {x, -1, 1}, {y, -1, 1}, {z, -0.001, 0.001}] Grid[{ VectorPlot3D[{x, y, z}, {x, -1, 1}, {y, -1, 1}, {z, ...


4

Just use MeshFunction. Manipulate[ParametricPlot3D[{Sin[\[Theta]] Cos[\[Phi]], Sin[\[Theta]] Sin[\[Phi]], Cos[\[Theta]]}, {\[Theta], 0, \[Pi]}, {\[Phi], 0, 2 \[Pi]}, PlotStyle -> Opacity[0.5], Mesh -> {{0.}}, MeshStyle -> {Red, Thick}, MeshFunctions -> {Sin[a] Cos[b] #1 + Sin[a] Sin[b] #2 + Cos[a] #3 &}], {a, 0, \[Pi]}, {b, 0, 2 \[Pi]}] ...


4

Scale does work in strange ways. I think it is a design flaw that some transformations are only carried out during rendering (or that Normal works on Translate, but not on Scale). This makes geometric computations very awkward at times. Ah, well. The following is a horrible frankenfix to make your example work. Essentially, you need to define your own ...


4

RegionPlot3D[x <= 5 && y + z <= 7 && x + y <= 8 && z <= 5, {x, 0, 10}, {y, 0, 10}, {z, 0, 10}, Mesh -> {{1, 2, 3, 4, 5}, {1, 2, 3, 4, 5}}] or RegionPlot3D[x <= 5 && y + z <= 7 && x + y <= 8 && z <= 5, {x, 0, 10}, {y, 0, 10}, {z, 0, 10}, Mesh -> 10, MeshFunctions -> ...


4

Just wrap ParametricPlot3D with Normal. The problem is that Mathematica starting from version 6 introduces more advanced data type GraphicsComplex. Normal converts to good old Graphics3D. Michael Trott's "Mathematica Guidebook for Graphics" was written for version 5. polys = Cases[ Normal[ ParametricPlot3D[#1, Evaluate[Sequence @@ #2], PlotPoints -> ...


4

With V10 you can use ClipPlanes Graphics3D[{Red, Opacity[0.5], Cuboid[]}, Axes -> True, ClipPlanes -> {{1, 1, -1, 0}}, ClipPlanesStyle -> {Directive[Opacity[0.2], Green]}] Show[Plot3D[Sin[x + y^2], {x, -3, 3}, {y, -2, 2}], ClipPlanes -> {{-1, 1, 0, 1}}, ClipPlanesStyle -> {Directive[Opacity[.3], Brown]}] Something like this? z = ...


4

Thanks to @shrx 's advise to use other coordinate. After some tuning, it finally works. Though a little ugly, but it's something I really want. The surface near equator still have some bugs which make it seems strange. Here is the code and renderings, which need further optimization. Here is the code and renderings, which need further optimization. elev1d ...


4

The OP's listParametricPlot3D constructs nonplanar quadrilaterals (Polygons) for a GraphicsComplex with Polygon[Flatten[ Table[{1 + i + xx j, 2 + i + xx j, 2 + i + xx (j + 1), 1 + i + xx (j + 1)}, {j, 0, yy - 2}, {i, 0, xx - 2}], 1]] where xx, yy are the dimensions of the tensor grid for the surface in the OP's data. One problem with nonplanar ...


3

Another approach: Manipulate[ Graphics3D[{GeometricTransformation[#, RotationTransform[ angle Degree, {b, c, d}]] & /@ {InfinitePlane[{{0, 0, 0}, {1, 0, 0}, {0, 1, 0}}], Arrow[{{0, 0, 0}, {0, 0, 1}}]}, InfiniteLine[{0, 0, 0}, {b, c, d}]}, PlotRange -> Table[{-3, 3}, {3}]], {angle, 0, 360, Appearance -> "Labeled"}, ...


3

There are many mistakes which I believe come from the Copy/Paste: cCos[theta_, xi_] := .5 (E^(xi + I theta) + E^ (-xi - I theta)); cSin[theta_, xi_] := (-.5 I) (E^ (xi + I theta) - E^ (-xi - I theta)); z1[theta_, xi_, n_, k_] := E^ (k*2*Pi*I/n)*cCos[theta, xi] ^ (2.0/n); z2[theta_, xi_, n_, k_] := E^ (k*2*Pi*I/n)*cSin[theta, xi] ^ (2.0/n); pz1[theta_, xi_, ...


3

Keep a list of the locations you add - draw from a uniform distribution and only add to the list if it doesn't overlap. cube = {Opacity[0.3], Cuboid[{0, 0, 0}, {20, 20, 20}]}; newLocation[existing_]:= Module[{try,count=1}, While[ try=RandomReal[{1,19},3]; Min[EuclideanDistance[try,#[[1]]]&/@existing]<2, count++ ]; {try,count} ] ...


3

h[et_] := Graphics3D[{Glow[Yellow], EdgeForm[et], Yellow, Cylinder[]}, Boxed -> False] ImageMultiply[ h[Black], ColorNegate@EdgeDetect@h[None]]


2

The problem is that your data is sorted in such a way that ListSurfacePlot3D can't draw the surfaces correctly. You can fix it by scrambling the data: ListSurfacePlot3D[RandomSample[xyz, 100000], BoxRatios -> {1, 1, 1}] However, this gets very slow with the increasing number of points and I'm assuming it won't be able to draw the elevation changes to ...


2

With V10 we can use RandomColor Graphics3D[Table[{RandomColor[], Sphere[RandomReal[{.1, .9}, 3], RandomReal[{0.03, 0.08}]]}, {50}], Lighting -> "Neutral"] Graphics3D[Table[{RandomColor[1, ColorSpace -> "LUV"], Sphere[RandomReal[{.1, .9}, 3], RandomReal[{0.03, 0.08}]]}, {50}], Lighting -> "Neutral"]


1

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 == ...


1

Use the option DataRange to specify the actual range of coordinates: ListPlot3D[Table[Sin[i/10 + j/100], {i, 0, 10, 1}, {j, 0, 100, 0.1}]] ListPlot3D[Table[Sin[i/10 + j/100], {i, 0, 10, 1}, {j, 0, 100, 0.1}], DataRange -> {{-5, 5}, {0, 10}}] Update: you can label the ticks the way you wish using the option Ticks: ListPlot3D[Table[Sin[i/10 + ...


1

My output looks a little bit different sphere = {Cos[u] Sin[v], Sin[u] Sin[v], Cos[v]}; MeanCurvature[f_] := With[{du = D[f, u], dv = D[f, v]}, Simplify[(Det[{D[du, u], du, dv}] * dv.dv - 2 Det[{D[f, u, v], du, dv}] * du.dv + Det[{D[dv, v], du, dv}] * du.du) / (2 Simplify[(du.du * dv.dv - (du.dv)^2)]^(3/2))]]; mean = ...



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