New answers tagged

6

"The nth-order Menger Sponge graph is the connectivity graph of cubes in the nth iteration of the Menger sponge fractal." ~ mathworld. So cubes are the vertices, and the neighboring cubes get an edge between them. You do not recognize Menger Sponge because Graph is applying some built-in GraphLayout, most probably "SpringElectricalEmbedding". So instead of ...


1

Graphics primitives you use in Graphics3D also work with regions - read about those in docs, there many helpful functions. For example, your case something as simple as this works: Volume[RegionUnion[ Ball[{0,0,0},0.986202], Ball[{0,0,0.831202},1.33191], Ball[{0,0,0.677365},1.23347] ]] 11.0001 and no need for ClipPlanes because ClipPlanes ...


1

In my experience, the RegionDistance and RegionNearest functions are quite fast even for meshed geometry. You could try the following workflow to see if it meets your needs. ClearAll[cyl, rdf, rnf, line, scnFn] cyl = Cylinder[{{0, 0, 0}, {0, 0, 2.}}, 1]; rdf = RegionDistance[cyl]; rnf = RegionNearest[cyl]; line[a_, b_, c_, x_, y_, z_][t_] := {a + x t, b + ...


3

There may be an analytic solution if I dig it out of the right book. This is a quick numerical solution. We interpolate the line from A to B with parameter t and NMinimize the distance to the nearest point on the cylinder determined by RegionNearest. The point on the line is then just linfn[tmin] and the point on the cylinder is just rnf[tmin]: cyl = ...


7

Create a list of line segments in the graph (this is rather kludgey, but I couldn't find a slick way to eliminate edges that were colinear with the edges): corners = {{0, 0}, {0, 3}, {4, 0}} sidepoints = {{0, 1}, {0, 2}, {1, 0}, {2, 0}, {3, 0}, {4/5, 12/5}, {8/ 5, 9/5}, {12/5, 6/5}, {16/5, 3/5}} sides = Subsets[corners, {2}] lines1 = Tuples[{corners[[1 ;;...


2

Here's how you can find approximate circle positions and radii given a list of intersection areas. I initially tried an exact approach with FindInstance but that would not complete execution for more than two circles. If we use NMinimize instead we get some inaccuracy for more than three disks, but at least it gives a close answer. In the example below - it'...


3

It is true that the following (incorrectly?) evaluates to $0$ on its own, instead of either returning an explicit expression, or returning unevaluated: Area[RegionIntersection[Disk[], Disk[{h, 0}, 1]]] (* Out: 0 *) I was surprised by that; @JM confirmed that version 11.2 returns a symbolic expression, as one would expect, so this appears to be ...


2

You can also use a composition of RegionIntersection, DiscretizeRegion and MeshCoordinates: MeshCoordinates[DiscretizeRegion @ RegionIntersection[cyl, line]] {{-1., 0., 0.}, {1., 0., 0.}} Or combine the three steps in a function: intersection = MeshCoordinates @* DiscretizeRegion @* RegionIntersection; intersection[cyl, line] {{-1., 0., 0.}, {1., 0., 0.}...


6

For the display cyl = Cylinder[{{0, 0, -1}, {0, 0, 1}}, 1]; line = InfiniteLine[{{0, 0, 0}, {1, 0, 0}}]; pts = {x, y, z} /. Solve[{x, y, z} ∈ RegionIntersection[line, RegionBoundary[cyl]], {x, y, z}] (* {{-1, 0, 0}, {1, 0, 0}} *) Graphics3D[ {{Opacity[0.25], cyl}, {Thick, Red, line}, {Black, AbsolutePointSize[6], Point[pts]}}, PlotRange -> {{...


0

Regarding the concluding paragraph of my question: "Also, can such codes be applied to non-"Basic Geometric Regions"? (My ambition would be to use the 3D regions specified by the constraints A, B, C at the end of Create a Venn and/or related diagrams given the eight atoms of a three-set (A,B,C) 256-dimensional Boolean algebra " I have just posted an ...


3

This is only a start, but is this within your capabilities/understanding? a={1,0,-1/Sqrt[2]};b={-1,0,-1/Sqrt[2]};c={0,1,1/Sqrt[2]};d={0,-1,1/Sqrt[2]}; Graphics3D[{Opacity[1/2], Sphere[a,3/2],Sphere[b,3/2],Sphere[c,3/2],Sphere[d,3/2], Text["A",a],Text["B",b],Text["C",c],Text["D",d], Text["AB",(a+b)/2],Text["AC",(a+c)/2], Text["AD",(a+d)/2],Text["BC",(...


1

You can think about it like this: If you have only one vector, you can rotate the plane around this vector and it would still be valid. Your point would lie on the plane and the vector would point along the plane. You would get infinitely many planes that match this description. Please see here for more details.


2

This is the same as Louis's idea, but I was able to devise a much shorter implementation, which does not rely on Solve[]: (* intersection of two lines; cf. https://mathematica.stackexchange.com/a/85903 *) lis[{{p1_, d1_}, {p2_, d2_}}] := With[{sol = LeastSquares[Transpose[{d1, d2}], p2 - p1]}, Mean[{p1 + sol[[1]] d1, p2 - sol[[2]] d2}]] (* https://...


1

In fact, it is not too hard to modify roundedPolygon[] from this answer so that it can take different rounding radii for the corners: arcgen[{p1_, p2_, p3_}, r_, n_] := Module[{cc, dc, th}, If[r > 0, dc = Normalize[p1 - p2] + Normalize[p3 - p2]; cc = p2 + r dc/EuclideanDistance[dc, Projection[dc, p1 - p2]]; th = Sign[...


6

~ 6 years ago, I wrote a little routine for gnomonically projecting a spherical texture onto a polyhedron: (* Newell's algorithm for face normals *) newellNormals[pts_List?MatrixQ] := With[{tp = Transpose[pts]}, Normalize[MapThread[Dot, {ListConvolve[{{-1, 1}}, tp, {{2, -1}, {2, -1}}], ListConvolve[{{1, 1}}, tp, {{-2, ...


7

Slightly changed last example from docs on GeoProjection. There are a few issues, for instance textures have different resolution. If I figure things out I'lll update the answer. But I thought this is a good start for you anyway. PolyhedronProjection[polyhedron_]:= Module[{pts3D,center,pts2D,proj,pts2Dprojected,geographics,plotrange,pts2Dscaled,rescale}, ...


2

I upvoted Cesareo's answer, but I thought demonstrating the reflection property of a parabola deserves a cute toy for the purpose: DynamicModule[{foc = {0, 2}, source = {-2, 2}, target = {2, 1/2}}, Dynamic[Show[Plot[With[{a = Last[foc]}, (x^2)/(4 a)], {x, -6, 6}, AspectRatio -> Automatic, PlotRange -> {0,...


2

From point from with direction direction onto the parabola f The incident beam is in blue, the reflected in green and the normal is dashed red. Clear[beam]; beam[from_, direction_, parabola_] := Module[{lambda, p, x, y, solx, dir = direction/Norm[direction], normal, vref}, solx = Solve[dir[[1]] parabola[x] == from[[2]] dir[[1]] + (x - from[[1]]) dir[[2]], ...


0

This works, but it's not clear if you want also handle the case where beams are not parallel to y-axis. Clear[f, parabola, beam]; f[x_] = x^2/8; parabola = Plot[f[t]}, {t, -4, 4}, PlotStyle -> {{Blue, Thickness[0.01]}}, AxesLabel -> {"x", "y"}]; beam[x_] := Module[{yc = f[x], m = RotationMatrix[2 ArcTan[f'[x]]]}, {Line[{{x, 6}, {x, yc}}], ...


4

Since both DelaunayMesh and ConvexHullMesh work on convex shapes, you probably should not expect them to work on concave shapes. You could split out the first 5 coordinate groups representing the base and do a difference operation with the rest of the points. polygonCoord = N[ToExpression[ Import["https://pastebin.com/raw/JYeSyxyp", "List"]][[1]]]; ...


Top 50 recent answers are included