Tag Info

New answers tagged

3

If we define the 2d cross product like this: cross2d[a_, b_] := a.{{0, 1}, {-1, 0}}.b I think it's just: Integrate[(Abs[cross2d[curveA'[t], curveB[t] - curveA[t]]] + Abs[cross2d[curveB'[t], curveB[t] - curveA[t]]])/2, {t, 0, 1}] Where the idea is that cross[curveA[t]-curveA[t+d], curveB[t] - curveA[t]]/2 is the area of the triangle {curveA[t], ...


2

Other folks have comments on other techniques for doing the sampling, but I wanted to address how you could actually do it with ReflectionTransformation—or, more accurately, why you should do it with RotationTransformation instead. ReflectionTransform[p] reflects points about the origin by default; it also points the "mirror" in the direction from the ...


3

To answer the question in the title: lineReflect[p0_?VectorQ, {p1_?VectorQ, p2_?VectorQ}] /; MatrixQ[{p0, p1, p2}] := 2 p1 - p0 + 2 Projection[p0 - p1, p2 - p1] A demonstration: GraphicsRow[{Graphics[{AbsolutePointSize[4], Point[{2, 4/3}], Line[{{1, 1}, {3, 2}}], Point[lineReflect[{2, 4/3}, {{1, ...


4

This is not quite a direct answer to your question, but if the end result is to have points sampled on a triangle, maybe the following would help: SeedRandom[1] triangle = Triangle[{{0, 0, 0}, {1, 1, 1}, {0, 1, 1}}]; Graphics3D[{ Red, triangle, Green, Ball[RandomPoint[triangle, 10], 0.02] }] A caveat: RandomPoint is new to Mathematica version 10.2 ...


1

It isn't perfectly clear what the desired scope and outcome is. For instance, Truncate will close a hole created in a polyhedron. That's not possible, if we truncate just one vertex of one polygon. If we truncate the right ones on the right polygons, then it could be done. The code below does not handle that case. It's a rather special case and would ...


2

This is surely a bug. The misbehavior certainly persists through V10.2. In fact, the two images below are of the same computation. The only difference is where they appear on the screen (as I scrolled the notebook, the transformed red disk jumped around). μ = 0.16255558520216132` + 0.1849493244071408` I; pic[τ_] := Block[{d, ds, arc}, d = Disk[{0, ...


4

I am using all your definitions, except for bores, which I modified to use Disk instead of Circle: bores = Disk[#, 1] & /@ {center1, center2}; RegionDifference[ DiscretizeRegion@RegionUnion[ Disk[center1, radius1], Disk[center2, radius2], Polygon[tangent[[1]]~Join~Reverse[tangent[[2]]]] ], DiscretizeRegion@RegionUnion[bores] ]


0

I have found a simple solution which is to compute the outer circular arcs and use the arcs instead of the circles: angle1 = ArcTan[tangent[[1, 1, 2]]/tangent[[1, 1, 1]]]; angle2 = ArcTan[tangent[[2, 1, 2]]/tangent[[2, 1, 1]]]; arc1 = Circle[center1, radius1, { -1 angle1, 2 \[Pi] + angle1}]; arc2 = Circle[center2, radius2, { -1 angle2, angle2}];


4

ConvexHullMesh[ Flatten[Table[{4 (a = {Cos[t], Sin[t]}), {8, 0} + 3 a}, {t, 0, 2 \[Pi], 0.1}], 1]]


4

I would suggest using Disk instead of Circle as a start; the following generates a Region object that should generate what you are looking for: center1 = {0, 0}; center2 = {8, 0}; radius1 = 4; radius2 = 3; circle1 = Disk[center1, radius1]; circle2 = Disk[center2, radius2]; endpoint1 = {x1, y1}; endpoint2 = {x2, y2}; tangent = {endpoint1, endpoint2} /. ...


4

tr[x_] :=Abs[TriangleWave[x 2^-(Floor[Log[2, 1 - x]] + 1)]/(Floor[Log[2, 1 - x]])] Visualizing: Plot[tr[x], {x, 0, 1}, GridLines -> {1 - PowerRange[1/2, 1/128, 1/2], Table[1/j, {j, 7}]}, Frame -> True]


5

Untested Just tested: With[{n = 20}, Plot[Sum[UnitTriangle[(x - 1) 2^(k + 1) + 3]/k, {k, n}], {x, 0, 1}]] Here is a solution that is entirely equivalent to ubpdqn's: Plot[Abs[TriangleWave[#1]/(#2 - 1)] & @@ MantissaExponent[1 - x, 2], {x, 0, 1}]


3

Actually there is nothing much wrong with your approach. You generate the coordinates for vertices you want to plot, but that's not enough. Graphics requires graphic primitives such as Line (the one to use in this case), so you need to wrap your coordinates in that primitive. pts[max_Integer?EvenQ] := Table[ {Boole[Mod[i, 2] == 0]*(1 - 2^(-i/2)) + ...


8

GeometricTransformation is an efficient graphics tool for drawing many affine transforms of a figure. Graphics[{ LightGray, EdgeForm[Lighter@Blue], GeometricTransformation[ Polygon[{{0, 0}, {1/2, 0}, {1/4, 1}}], ScalingTransform[{2^(1 - #), 1/#}, {1, 0}] & /@ Range[100] ]}, Frame -> True ]


9

Another approach would be to consider the triangles as graphics primitives. The first triangle would be constructed manually with Triangle[{{0, 0}, {1/4, 1}, {1/2, 0}}] and each other triangle would be constructed by translating and scaling properly the first triangle. A set of triangles would be obtained with myTriangles[number_] := NestList[ {Scale[ ...


5

heights = Table[1/(k 2^(k + 1)), {k, 1, 15}]; widthpositions = Partition[Accumulate@Prepend[NestList[#/2 &, 1/2, 14], 0], 2, 1]; Plot[MapThread[#1 PDF[TriangularDistribution[#2], x] &, {heights, widthpositions}], {x, 0, 1}, Filling -> Axis]


6

Here is another couple of takes on the same problem. Both attempts construct a list of base points (in red in the plot below), and a separate list of apex points (in blue), then they Riffle the two lists together to get a list of points to plot with ListPlot. The first approach uses MovingAverage to determine the $x$ position of the apex points: nmax = 10; ...


5

g[n_] := Sum[1/2^i, {i, 1, n}]; f[n_] := (- 1/2^(n + 1) + g[n] ) t1 = Table[{f[n], 1/n}, {n, 1, 20}]; t2 = Table[{g[n], 0}, {n, 0, 20}]; t3 = Sort[Union[t1, t2]] ListPlot[t3, Joined -> True, Filling -> Axis, PlotRange -> All] You can try also with your code: linelist = Table[{Boole[Mod[i, 2] == 0]*(1 - 2^(-i/2)) + Boole[Mod[i, 2] == 1]*(1 ...


8

num=100 p = Partition[Accumulate@Prepend[NestList[#/2 &, 1/2, num - 1], 0], 2,1]; ListLinePlot[Join @@ MapThread[{{#1[[1]], 0}, {Mean[#1], #2}, {#1[[2]], 0}} &, {p, 1/Range@Length@p}], PlotRange -> All]


1

As I understand it (not what @Patrick suggested) line[t_] := {ax, ay} + {bx, by} t pt = {px, py}; ax = ay = bx = by = 2 px = 77; py = 142; Minimize[ChessboardDistance[pt, line@t], t] (* {65/2, {t -> 215/4}} *)


6

I'm not sure which points you really want, so this is a stab in the dark: You could "walk around" the inner resp. outer circle, and pick the closest point in pts to every point on each circle. (code for the animation at the bottom of the answer.) Mathematica's Nearest function makes this relatively quick: n = 1000; pts = {#[[1]] Cos[#[[2]]], #[[1]] ...



Top 50 recent answers are included