New answers tagged

1

Consider pre-evaluating your region descriptor conditions: regiondescriptor = Tr[{{0.09, 0}, {0, 7}}.{{x1^2, x1*x2}, {x1*x2, x2^2}}] <= 1 && Tr[{{7, 0}, {0, 0.09}}.{{x1^2, x1*x2}, {x1*x2, x2^2}}] <= 1 && Tr[{{1.05, -0.95}, {-0.95, 1.05}}.{{x1^2, x1*x2}, {x1*x2, x2^2}}] <= 1 && Tr[{{1.05, 0.95}, {0.95, 1.05}}.{{x1^2, ...


1

ubpdqn beat me to it and his looks better. You can have no knowledge about the problem at all and still get Mma to get the answer, just use it like Geogebra on steroids. t = SSSTriangle[30, 30, 30]; cent = RegionCentroid[t]; Maximize[y, {x, y} \[Element] Circle[cent, 15]]; big = Circle[cent, 15 + 15 Sqrt[3] - 5 Sqrt[3]]; Graphics[{t, Circle[{0, 0}, 15], ...


3

To verify that the rotations happen the way they're supposed to according to the documentation for EulerMatrix, you could use the following Manipulate: Clear[arrowAxes]; arrowAxes[arrowLength_: 1] := Map[{Apply[RGBColor, #], Arrow[Tube[{-#, #}]]} &, arrowLength IdentityMatrix[3]] Manipulate[ Graphics3D[{GeometricTransformation[arrowAxes[.7], ...


5

This is just to illustrate for the first problem (calculation and visualization). Module[{tg = SSSTriangle[30, 30, 30], c, ans}, c = RegionCentroid[tg]; ans = EuclideanDistance[c, tg[[1, 1]]] + 15; Graphics[{Circle[c, ans], LightGray, Disk[#, 15] & /@ tg[[1]], Red, PointSize[0.02], Point[tg[[1]]], EdgeForm[Black], FaceForm[None], Polygon[tg[[...


5

For your 1st problem, assume the following. r is radius of small circles. s is the distance between the center of the large circle and the center of any of small circles. R is the radius of large circle. r == 15 is given; r == s Sin[60 °] and R == r + s by inspection, so With[{r = 15}, Solve[Eliminate[{r == s Sin[60 °], R == r + s}, s], R]][[1,1]] ...


0

Marsaglia's method: uniform on disk (here rejection method), transform by Lambert azimuthal equal-area projection: http://mathworld.wolfram.com/SpherePointPicking.html uniformDisk[n_] := Take[Select[Table[RandomReal[{-1, 1}], {3 n}, {2}], #.# <= 1 &], n]; diskToSphere[p_] := {2 p[[1]] Sqrt[1 - Dot[p, p]], 2 p[[2]] Sqrt[1 - ...


9

You are looking for TransformedRegion. GeometricTransformation is for transforming graphics primitives, but you are looking at region functionality. This is a case where the difference is important. Simply, t = TransformedRegion[p, AffineTransform@A] (* Parallelogram[{0, 0}, {{-1, 2}, {3, 0}}] *) where the AffineTransform was needed as TransformedRegion ...


2

One can use FindMinimum[] with RegionDistance[rect] to get a quick, accurate result. Speed can be expected here because we have a good estimate for a starting value for s in the parameter T. Block[{T = 1.}, rect = Polygon[{{xr1, yr1}, {xr2, yr2}, {xr3, yr3}, {xr4, yr4}} /. {t -> T}]; df = RegionDistance[rect]; ndf[{x_Real, y_Real}, df_] := df[{x, y}]...


3

For an approximately even distribution of points on any surface with cylindrical symmetry, we can use the Golden Angle, the same way that the sunflower uses it on the plane. To place N points on the surface of a sphere, define an axis. Divide the surface into N equal area strips perpendicular to the axis. For k in 0 to N-1, on the kth strip, place a point ...


4

With[{n = {3, 4, 5, 6, 7, 20}}, Partition[show[points[#]] & /@ n, 3]] // GraphicsGrid With the code below, with piecewise spring forces (exclusively repulsive) and Cartesian vectors. A different model for force and switch to spherical vectors would probably be wise. show[points_] := Graphics3D[{ Opacity[.5], Sphere[], Opacity[1], PointSize[...


1

Something like this I think, You first extract your points from the curve, then define the polygon to be a function of the parameter T pts = Cases[ParametricPlot[{xc, yc}, {s, 0, 4},PlotPoints->300], Line[{x__}] :> x, Infinity]; pgon[T_] := Polygon[{{xr1, yr1}, {xr2, yr2}, {xr3, yr3}, {xr4, yr4}} /. {t -> T}] (edit I had to add a high ...


7

Aha~ I suppose this question is created while solving this. Am I correct @yode :P So here's an easy solution, simple, elegant, and may I say even quite fast after some optimization? pt = With[{p = Table[{x[i], y[i], z[i]}, {i, 80(*number of charges*)}]}, p /. Last@ NMinimize[ Total[1/Norm[Normalize[#1] - Normalize[#2]] & @@@ ...


12

If more ad hoc, inexact approaches are welcome, one way to generate relatively uniform density of points on a sphere is to use Monte Carlo Lloyd's algorithm (modified for the spherical case): With[{points = 200, samples = 40000, iterations = 20}, Nest[With[{randoms = Join[#, RandomPoint[Sphere[], samples]]}, Table[Normalize@Mean@Extract[randoms, ...


6

Correct me if I'm wrong... but I suppose, pedantically speaking, there are only five solutions defined by Platonic solids, and trivial solutions for 0-3 points (extension of CirclePoints). Thus: ClearAll[spherePoints]; spherePoints[r_: 1, n_ /; 0 <= n < 4] := {##, 0} & @@@ CirclePoints[r, n]; (spherePoints[r_: 1, PolyhedronData[#, "VertexCount"]...


2

For points uniformly spaced in angular variables, you can use CirclePoints. spherepoint[m_, n_] := Union@Flatten[Table[Join[{Cos[q]}, Sin[q] #] & /@ CirclePoints[n], {q, 0, Pi, Pi/m}], 1] ListPointPlot3D[spherepoint[20, 30], BoxRatios -> 1] For uniformly spaced in Cartesian coordinates, things would be complicated. The ...


1

If you do not want to use RegionUnion[], it is easy to produce a Polygon[] corresponding to the desired shape: this hinges on the use of the undocumented functions Graphics`PolygonUtils`PolygonUnion[] and Graphics`PolygonUtils`PolygonCombine[]. (In much older versions, they were in the Graphics`Mesh`​ context.) In your case, you will need the additional step ...


4

For a closed surface such as this one, a slight modification of the function MakeTriangleMesh[] in this answer can be used: MakeTriangleMesh[vl_List, {closedu : (True | False) : False, closedv : (True | False) : False}, opts___] := Module[{dims = Most[Dimensions[vl]], v = vl, idx}, idx = Partition[Range[Times ...


1

Why not go to the WRI demo site and search for demos involving the Dandelin spheres? You can download the source code and see how some others did it. For example: http://demonstrations.wolfram.com/DandelinSpheresForAnEllipse/


3

Here's a starting point. Figuring out what I exactly did is left as an exercise. With[{r = 5/2, φ = π/4, s1 = 3/4, s2 = 3/2}, Graphics3D[{{Directive[CapForm[None], Opacity[2/3]], Tube[{{0, 0, -r Cot[φ/2]}, {0, 0, 0}, {0, 0, r Cot[φ/2]}}, {r, 0, r}]}, {Sphere[{0, 0, s1 Csc[φ/2]}, s1], Sphere[{0, 0, -s2 Csc[φ/2]}, s2]}, ...


3

I came up with a solution using ReflectionTransform[]. Here's my code: TabView[{ "Square" -> Manipulate[Graphics[ {{Opacity[1], Red, Rectangle[{a,b},{c,d}]}, Line[{{5, 5}, {5, -5}}], GeometricTransformation[{Opacity[1], Blue,Large,Rectangle[{a,b},{c,d}]}, ReflectionTransform[{5, 0}, {5,0}]]}],{a,0,2},{b,0,2},{c,1,4},{d,1,4} ], "Triangle" -&...


2

As noted in the docs, the only effect of specifying VertexNormals is in the shading; recall that Mathematica uses the Phong model for depicting surfaces. The docs also have a review of how shading is done in Mathematica. For further illustrations, here is a modified version of your demonstration function g: g[p_, nl_, opts___] := Graphics3D[{FaceForm[...


2

As J.M. and others have observed DirichletDistribution can be used. In the following simulation the random variate is used to generate lower left points of randomly placed triangles. The intersection and its area are calculated with built-in functions. This is not efficient but I present v[250] and stat[10000]. v[n_] := Table[ Module[{d = RandomVariate[...


1

We can start by trying to improve the simulation I gave in the OP. AbsoluteTiming[ n = 1000; ans = Table[ {a, b} = RandomVariate[DirichletDistribution[{1, 1, 1}]]/2; {c, d} = RandomVariate[DirichletDistribution[{1, 1, 1}]]/2; t1 = Polygon[{{a, b}, {a, b + 1/2}, {a + 1/2, b}}]; t2 = Polygon[{{c, d}, {c, d + 1/2}, {c + 1/2, d}}]; Area[RegionIntersection[...


11

You can use RegionDistance to find the distance from a point to a region. {a, b, c, d} = {1, 2, 3, 4}; plane = ImplicitRegion[a x + b y + c z + d == 0, {x, y, z}]; RegionDistance[plane, {x0, y0, z0}] // Simplify (* Sqrt[(4 + x0 + 2 y0 + 3 z0)^2]/Sqrt[14] *) However it is probably a good idea to also read this to understand how to find the answer ...


3

I post this with the following interpretation. There are 2 unequal size circles: one fixed and one rolling without slipping (cycloid). The circles initially intersected and the desire is to animate their intersection (I have made the approximate 'kissing of the circle continue on). I have made convenient choices for origins etc. If this is close to the ...


0

Description This solution does not fully cover the requirements of the original post, but it does achieve the desired output. In order to visualize how arbitrary gas cloud fills up the available volume, I have combined two Cuboid regions using RegionUnion. This new region has then been tested for intersection with a Ball of varying radii using ...


4

In case size means length of each edge: edgeLength = PolyhedronData["TruncatedCube", "EdgeLengths"][[1]]; Graphics3D[ GeometricTransformation[ First @ PolyhedronData["TruncatedCube"], ScalingTransform[{1, 1, 1} (Sqrt[2] - 1)/edgeLength] ] , Axes -> True ]



Top 50 recent answers are included