11

So DiscretizeGraphics seems to always miss the first or last point of a BSplineCurve (it seems to do it with a BezierCurve as well). Here's the simplest example of this, pts = {{.5, 0}, {1, 0}, {1, 1}, {.5, 1}, {0, 1}, {0, 0}, {.5, 0}}; GraphicsRow[{Graphics@#, DiscretizeGraphics@#} &@BSplineCurve[pts], ImageSize -> 600] Why does it do this? Not ...


11

It took quite a while, but I've finally come up with a way to generate discretized tubes. This again is based on work in this previous answer (from the thread mentioned earlier by Michael). In the interest of keeping things short, I will not be repeating the definitions of orthogonalDirections[], extend[], and crossSection[] from that answer. Here, then, is ...


9

Since version 10.1, there has been a built-in function CoordinateBoundsArray to do this kind of thing. It is readily adapted to your special case. lattice[d_Integer?Positive, r_?NumericQ] := Flatten[CoordinateBoundsArray[ConstantArray[{-1, 1}, d], r], d - 1] lattice[2, 1] {{-1, -1}, {-1, 0}, {-1, 1}, {0, -1}, {0, 0}, {0, 1}, {1, -1}, {1, 0}, {1, 1}} ...


8

Here's a pretty general solution. This generates the desired boundary lattice points in $[0,1]^d$; apply Rescale[] as needed: makeGrid[d_Integer?Positive, n_Integer /; n > 1] := Module[{sh = {{0}, {1}}, ins = ArrayPad[Subdivide[n], -1]}, Do[sh = Insert[Transpose[Outer[Append, CoordinateBoundsArray[ConstantArray[{0, 1}, k], ...


7

An alternate, i suspect faster, way to get your evenly spaced points, using linepoints from here: https://mathematica.stackexchange.com/a/39457/2079 DiscretizeGraphics@ Line[linepoints[ Table[ BSplineFunction[{{0.1288208346384372`, 0.24716061799090383`}, {0.18307091717113483`, 0.29633799186027077`}, {0.18104183370580254`, ...


7

Looks like you've uncovered a bug. I can confirm this behavior in 10.3.1 and 10.4. You can still discretize your region using DiscretizeGraphics though: r = DiscretizeGraphics@ RegionPlot[0 < Sin[u]/Cos[v] < 1 && 0 < Sin[v]/Cos[u] < 1, {u, 0, 2}, {v, 0, 2}] And if you want finer areas, use DiscretizeRegion: DiscretizeRegion[r, ...


6

Since Tube is rendered in the front end, there may be no way to discretize it. But here is a way to generate a tube and discretize it: DiscretizeGraphics@ ComputationalGeometry`Methods`GraphicsComplexTube[ Table[{t, t^2, t^3}, {t, -1, 1, 0.1}], 0.2, PlotPoints -> 25, Mesh -> All] One might do a similar discretization of any of the methods found ...


6

A possible workaround (brought up by the Wizard in the comments) involves the use of some of the functions from this previous answer. In particular, you will need orthogonalDirections[], extend[], and crossSection[] from that answer, along with these two additional functions for generating a suitable MeshRegion[] object: MakeTriangleMesh[vl_List, opts___] :=...


5

You could try something like this: generateGrid[dim_] := DeleteCases[Tuples[{-1, 0, 1}, dim], {0 ..}] For the case of specifying a resolution as well, try: generateGrid[dim_, r_] := Select[Tuples[Range[-1, 1, r], dim], Max@Abs[#] == 1 &] Graphics3D@Point@generateGrid[3, 1/2] But it won't be very efficient for higher dimensions or fine resolution, ...


5

If you restructure your datasets to have each row representing {x,t,y} with y as the response variable, it should be pretty straightforward. Here is an example with some simulated data. (* Define a function *) f[x_, t_, p1_, p2_] := p1 + Sin[x + t p2] (* Common parameters *) p1 = 0.2; p2 = 2; (* Data set 1 *) x1 = 1; data1 = Table[Flatten[{x1, t/100., f[...


5

You could try this as a workaround for now: boundary = ToBoundaryMesh[reg, "BoundaryMeshGenerator" -> "RegionPlot", "MaxBoundaryCellMeasure" -> 0.01]; boundary["Wireframe"] pp = boundary["Coordinates"]; Select[pp, #[[1]] == 1. && #[[2]] == 1. &] Select[pp, #[[1]] == 1. && #[[2]] == 0. &]


5

How about the following: a = BoundaryDiscretizeRegion[Ball[{0, 0, 0}, 1], MaxCellMeasure -> {"Length" -> 3}, PrecisionGoal -> 0.01] Length determines the size of the triangulation which gives:


5

Here is a function which you pass it the time, and will return True is point is inside the rectangle else False. This is based on test given in how-to-check-if-a-point-is-inside-a-rectangle The implementation of the above is also given in finding-whether-a-point-lies-inside-a-rectangle-or-not which I translated to Mathematica and added a small Manipulate on ...


5

Far from efficient, but we can adapt the Neat Example from the RegionDisjoint ref page. Note that a non-uniform distribution of radii would probably speed things up. outerReg = Annulus[]; randomBall[dim_, reg_] := ( While[ !RegionWithin[reg, ball = Ball[RandomPoint[reg], RandomReal[{1/15, 1/6}]]], (* spin *) ]; ball ) appendDisjointBall[dim_]...


4

a graph approach: p = Position[grid, 1]; v = Range@Length@p; e = UndirectedEdge @@@ (Select[Subsets[v, {2}], EuclideanDistance @@ p[[#]] <= Sqrt[2] &]); g = Graph[v, e, VertexCoordinates -> Reverse /@ p]; HighlightGraph[g, Select[v, GraphDistance[g, 240, #] < 10 &], VertexSize -> 2] HighlightGraph[g, Map[Style[#, Hue[...


4

I suspect that the cells closest to the $z$ axis in your region did not get optimized because their volume was simply too small to trigger the mesh refinement function: the solid is so thin in the vicinity of the $z$ axis, and its thickness is changing so rapidly, that any constant volume requirement small enough not to trigger the generation of thousands of ...


4

Text does not scale with the ImageSize. Try to manually resize graphics containing text (by dragging the handle). The text will not change size. Text size is given in absolute units. To get the dimension of text in absolute units (which is distinct from the Graphics coordinate system), use Rasterize[..., "RasterSize"]. If you use "BoundingBox" instead ...


4

bsf = BSplineFunction[{{1, 4}, {5, 3}, {9, 4}, {5, 5}, {8, 7}}, SplineClosed -> True]; line = Cases[ParametricPlot[bsf[t], {t, 0, 1}] [[1]], _Line, All][[1]]; mesh = Range[0, 1, .1]; coords = Nearest[RegionIntersection[line, InfiniteLine[{bsf[#], (bsf[#] + Cross[bsf'[#]])}]][[1]]][bsf[#], 2] & /@ mesh; ParametricPlot[bsf[t], {t, 0, 1}, ...


4

You can use IntegerPartitions, which (despite its name) also partitions rationals. Your problem is to partition the number 1 into a set of $d$ nonnegative integer multiples of step: d = 3; step = 1/2; Flatten[Permutations /@ IntegerPartitions[1, {d}, Range[0, 1, step]], 1] (* {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}, {1/2, 1/2, 0}, {1/2, 0, 1/2}, {0, 1/2, 1/2}} *) ...


3

You can also use Mesh as follows: mesh = Join[Subdivide[-Pi, -1, 20], Subdivide[-1, 1, 50], Subdivide[1,Pi, 20]] Plot[Sin[x], {x, -Pi, Pi}, Mesh -> {mesh}, MeshStyle -> Red, PlotStyle -> None] In version 9 or earlier versions, you can define mesh using Range instead of Subdivide as follows: mesh = Join @@ Range[{-Pi, -1, 1}, {-1, 1, Pi}, {(-...


3

Here one option is to add new points to increase density in a range. The pointsInitial list is the values ​​you have in your points list. I've created a new list that creates new points for your given interval. The Subdivide function controls how many points you want in the minimum and maximum limits. Then two controls were created for number of points. ...


3

As this regular we know the min height of Graphics is 16 (Graphics[{Black, Rectangle[]}, ImageSize -> {1, #}] // Binarize // ImageData // Dimensions) & /@ Range@19 {{16, 1}, {16, 1}, {16, 1}, {16, 1}, {16, 1}, {16, 1}, {16, 1}, {16,1}, {16, 1}, {16, 1}, {16, 1}, {16, 1}, {16, 1}, {16, 1}, {16,1},{17, 1}, {17, 1}, {18, 1}, {19, 1}} So we ...


3

NOT A ANSWER Once corrected, your code gives the following with Mathematica 10.3.1 (on the "Wolfram Development PlatForm") It looks like a little bit better than what you obtain. EDIT I can't investigate further : my code crashes on the "Wolfram Development Platform"


3

It can be done easy in MMA 11, just define the Region-wire by built-in functions ir = ParametricRegion[{Cos@t, (Sin@t)^2, 10/(t + 0.1)^0.5}, {{t, 0, 6 π}}] DiscretizeRegion[ir]


3

I am not sure I understand what the issue is and only post this in case it facilitates: Module[{r1 = Cuboid[{0, 0, 0}, {5, 5, 5}], r2 = Cone[{{0, 0, 0}, {5, 5, 5}}, 3]}, i = DiscretizeRegion[RegionIntersection[r1, r2]]; Show[ Graphics3D[{Opacity[0.3], White, r1, Opacity[0.1], LightBlue, r2}], RegionPlot3D[i, PlotPoints -> 50], Boxed -> ...


3

Some of the polygons in your graphics object are hitting a bug in DiscretizeGraphics. A minimal example, using the definition in the OP is {Graphics3D@#, DiscretizeGraphics@#} &@ annulusArc[[1, 1]] I can offer a workaround which involves constructing the region in question as a boolean region. region = 1.4 < x^2 + y^2 < 1.6 && 1.4 < z ...


3

As I noted in the comments, a judicious combination of RegionImage[] and ImageMesh[] will yield suitable voxelizations of regions. Applied to the OP's example: reg = TransformedRegion[Ball[{10, 10, 10}, 2], ShearingTransform[π/5, {1, 0, 0}, {0, 0, 1}]]; ImageMesh[RegionImage[DiscretizeRegion[reg]]]


3

Simply add the option "MeshElementType" -> TriangleElement: Needs["NDSolve`FEM`"]; ToElementMesh[Rectangle[{-6.5, 0}, {6.5, 6}], "MeshElementType" -> TriangleElement ]["Wireframe"]


3

Here are a couple of corrections. I am not sure this is what you are looking for: eps = 0.1 g1 = 1 random = Table[{x, y, RandomReal[]}, {x, 0, 2 π, 2 π/10}, {y, 0, 2 π, 2 π/10}]; random[[All, -1, -1]] = random[[All, 1, -1]]; random[[-1, All, -1]] = random[[1, All, -1]]; iniIF = Interpolation[Flatten[random, 1]]; ini[x_, y_] := 1 + iniIF[x, y] sols = ...


3

As a workaround you can use the second argument of BoundaryDiscretizeRegion: Table[BoundaryDiscretizeRegion[iShell[[i]], {{-1, 1}, {-4, 4}, {-1, 1}}], {i, 27, 29}]


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