Tag Info

61

There are already good answers, but I'm going to improve the performance, generalize to any region in any dimensions and make the function more convenient. The main idea is to use DirichletDistribution (the uniform distribution on a simplex, e.g. triangle or tetrahedron). This idea was implemented by PlatoManiac and me in the related question obtaining ...

49

Update: Extended to Include 3D Shapes I have extended the workflow to include using 3D shapes including an imported 3D CAD object at the end of this answer. Original Post Here is a slight adaptation to my answer to your previous question here. It uses region functions, but not RegionIntersection. Rather it relies on the ray advancing to within the ...

47

This is based on Rahul's ideas, but a different implementation: contourRegionPlot3D[region_, {x_, x0_, x1_}, {y_, y0_, y1_}, {z_, z0_, z1_}, opts : OptionsPattern[]] := Module[{reg, preds}, reg = LogicalExpand[region && x0 <= x <= x1 && y0 <= y <= y1 && z0 <= z <= z1]; preds = Union@Cases[reg, _Greater | ...

38

EDIT 01: The original code had an issue when the angle of the ray is counterclockwise from the normal of the circle, which I didn't catch. The code should be correct now, I think. RegionIntersection and friends are really nice functions if you just need to find a couple of values, but it looks to me like RegionIntersection will be called 500 times (since ...

35

This assumes uniform distribution. See answer by @JimBaldwin for discussion on limitations (implicit assumptions) of my answer. Answer region = ImplicitRegion[0.5 < q < 1. && 0.5 < p < 0.5/q, {p, q}]; RandomPoint[region] (* {0.793318, 0.550934} *) Visual Show[ RegionPlot[region] , ListPlot[RandomPoint[region, 1000], PlotStyle -> ...

31

Assuming polygons follow the same (clockwise or counterclockwise) vertex order, find all good quality two line segment rigid mappings between polygons without overlap with each other (at least much overlap, that is). Construct a graph of these mappings and apply appropriate transforms to polygons by finding transform paths from one polygon to all others. (In ...

28

The question does not state an essential piece of information which is the joint distribution of $p$ and $q$. All of the previous answers (so far) jump to a solution without making the joint distribution explicit (at least prior to what one sees in the code and the resulting figures). The answers using regions assume that $p$ and $q$ have uniform ...

28

UPDATE: The previous version of my answer worked, but did not give control on the rounding radius, nor did it fully work with as a starting point for a geometric region for further calculations. Here is a version that is still based on spline curves, but it gives full control over the corner rounding radius. It also returns a FilledCurve object that in my ...

27

Good news! Version 10.2 of Mathematica has this built-in with the function RandomPoint[]. From the documentation: RandomPoint can generate random points for any RegionQ region that is also ConstantRegionQ. RandomPoint will generate points uniformly in the region reg. The first example given is a simple disk, but there are a whole host of neat ...

25

If I'm not mistaken, a complement is defined as the set of elements in one set that are not contained in a given other set. In your case, you have specified the 'other' set (the union of S1, S2 and S3), but not the 'one' set. As you phrased it, I guess that set must be $\mathbb R^3$. So, the complement is the difference between an infinite space and a finite ...

23

Update 2: Finally ... in version 12.1 you can use the new directives HatchFilling and PatternFilling: Graphics[{EdgeForm[{Thick, Black}], #, blob}, ImageSize -> 300] & /@ {HatchFilling[], Directive[Red, HatchFilling[Pi/2, 2, 10]]} // Row Graphics[{EdgeForm[{Thick, Black}], PatternFilling[#, ImageScaled[1/20]], blob}, ImageSize -> 300] &...

23

I suspect the problem arises from too coarse a mesh when the Disk region is discretized. A better result is obtained if the region is created explicitly with a finer mesh at the edge. region = DiscretizeRegion[Disk[], MeshRefinementFunction -> Function[{vertices, area}, area > 0.005 (1 - Norm[Mean[vertices]]^2)]] sol = NDSolveValue[{-...

23

Interpolation error The overshoots are the unavoidable result of interpolation. NDSolve computes the values of u of the DirichletCondition to machine-precision accuracy and approximates the values of u at other points in the mesh via the finite element method. Values at intermediate points are interpolated by polynomials that equal the values of u at the ...

22

Update Compare two pictures. First is able to make mistake like you made the code. You need to do like this code using Mod[ArcTan[x, y], 2π]. h[r_,θ_] := 2 < r <= 5 && 3/4 π < θ < 3/2 π RegionPlot[ h[Sqrt[x^2 + y^2], Mod[ArcTan[x, y], 2π]], {x, -6, 6}, {y, -6, 6}] So I suggest to use ParametricPlot like this. rg = 6; mg = 3; ...

22

For a different approach with image processing, I start with the image of your puzzle. fig = Import["http://i.stack.imgur.com/xpue6m.jpg"]; comp = MorphologicalComponents[fig // Binarize]; comp = Colorize[comp, ColorFunction -> "Rainbow"]; cols = DominantColors[comp, 20]; blocks = ColorNegate[Binarize@ColorReplace[comp, Cases[cols, Except[cols[[#...

22

Here's an approach that should produce the globally optimal solution (code below): After some preprocessing, the performance is real-time capable as shown in the gif. The preprocessing needs to be run once for each region, but takes less than 3 seconds on my machine for the region in the question. The functionality is now available via the resource function ...

21

In principal you should be able to do r = RegionDifference[Ball[{0, 0, 0}], Ball[{0, 0, 1}]]; rp = RegionPlot3D[r, PlotPoints -> 50]; DiscretizeGraphics[rp] Unfortunately, this does not work and is hopefully improved in a future version. One thing you can do, however, is use the finite element mesh generator for this: Needs["NDSolveFEM"] m = ...

21

Many solutions similar to how to get $n$ equidistributed points on the unit sphere are possible, especially if one can accept that points are not on the edges of a region. For instance, one can use analytical Lloyd's method: With[{reg = RegularPolygon}, Nest[RegionNearest[reg][ RegionCentroid@RegionIntersection[reg, #] & /@ ...

20

Annealing Found this to be an interesting question and immediately I thought it to be a good application for simulated annealing. Here's a little unoptimized annealing function I wrote. The idea is that your points move around like atoms in random directions but they "cool down" over time and move less and settle into a minimum energy configuration state. ...

19

Perhaps more a comment: note differences: r = RandomReal[{0.5, 1}, {10000, 2}]; Show[ListPlot[Sort@GatherBy[r, Times @@ # < 0.5 &], PlotStyle -> {{Red}, Blue}], Plot[1/(2 x), {x, 0.5, 1}, PlotStyle -> Green], Frame -> True] compared with: ListPlot[{#, RandomReal[{0.5, 1/(2 #)}]} & /@ RandomReal[{0.5, 1}, 10000], PlotStyle -> ...

19

A simple alternative is to use Plot3D with both RegionFunction and Filling. Plot3D[y, {x, 0, 1}, {y, 0, 1}, RegionFunction -> Function[{x, y, z}, x^2 + y^2 <= 1 && x >= 0 && y >= 0 && z >= 0], Filling -> 0, FillingStyle -> Opacity[.75], PlotStyle -> Opacity[.5], AxesLabel -> (Style[#, 14, Bold] &...

19

Just wanted to add purely mathematical approach using complex mapping technique. PolyMap[n_, z_] := z Hypergeometric2F1[1/n, 2/n, (n + 1)/n, z^n] (* Integrate[1/(1 - ξ^n)^(2/n), {ξ, 0, z}] *) g = GraphicsGrid[ Table[ ParametricPlot[ z = PolyMap[n, r (Cos[t] + I Sin[t])]; {Re[z], Im[z]}, {t, 0, 2 π}, PlotRange -> All, Axes -> False] /. ...

19

In the documentation of Area: The area of a region of dimension three or higher is $\infty$: For the surface area you can do: Area @ RegionBoundary @ Ellipsoid[{0, 0, 0}, {1, 2, 3}] π (2 + 8 Sqrt EllipticE[ArcCos[1/3], 27/32] + Sqrt EllipticF[ArcCos[1/3], 27/32])

18

The inertia tensor is defined as an integral of the following tensor over the body region vars = {x, y, z}; r2 = IdentityMatrix Tr[#] - # &@Outer[Times, vars, vars]; r2 // MatrixForm It is very simple to do with integration over a region Integrate[r2, vars ∈ region] It can be wrapped in the following function inertiaTensor[reg_, assum_: {}] := ...

18

Update Silvia proposed a much faster algorithm that I believe produces I uniform distribution. Here is my implementation of it. pointsInMask2[mask_Image, n_Integer, range : {_, _} : {0, 1/2}] := Reverse @ ImageData @ Binarize[mask, range]\[Transpose] // SparseArray[#]["NonzeroPositions"] & // RandomChoice[#, n] + RandomReal[{-1, 0}, {n, 2}] ...

18

Using RandomPoint[] with TubeMesh[] (routines from here and here) does the job: helix = First[Cases[Normal[ParametricPlot3D[{6 Cos[t], 6 Sin[t], t}, {t, -2 π, 4 π}, MaxRecursion -> 1, PlotPoints -> 75]], Line[l_] :> l, ∞]]; tube = TubeMesh[helix, 1/2, "CapForm" -> "Round"]; ...

17

Assuming you just ommitted the parentheses and meant $1/(2q) > p$, then this works q = RandomReal[{0.5, 1}] p = RandomReal[{0.5, 1/(2 q)}] Edit: The above code will generate 2 random numbers that satisfy the given criteria, they won't be sampling the same distribution. qlist = RandomReal[{0.5, 1.0}, 10000]; plist = RandomReal[{0.5, 1/(2 #)}] & /...

17

Since you mention that you want to use the rounded polygon in NDSolve[] as a region, you might want to look at the following construction: With[{r = 1/5 (* rounding radius *)}, rp = DiscretizeRegion[ ImplicitRegion[RegionDistance[ Polygon[CirclePoints[{1 - 2 Sqrt[5 - 2 Sqrt] r, π/10}, 5]], {x, y}] <= r Sqrt[(5 - ...

17

Mathematica makes this fairly simple. We can define a region region = RegionDifference[Disk[{a, 0}, a], Disk[{0, 0}, b]] (* BooleanRegion[#1 && ! #2 &, {Disk[{a, 0}, a], Disk[{0, 0}, b]}] *) You can visualise this quite simply, for specific values of a and b with the following line Block[{a = 3, b = 1}, Region[region]] and an integrand ...

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