Hot answers tagged geometry
32
I'm going to brute force it numerically.
First, let's define the function we're interested in:
fun = KnotData[{3, 1}, "SpaceCurve"]
Imagine that this function fun[t] describes the position of a moving point in time. The the magnitude of its velocity as a function of the time t is
Sqrt[#.#] & [fun'[t]]
I'm going to make an interpolating function ...
21
I'm coming to the party a bit late, but here's my approach. It should work for any two polygons, including non-convex and self-intersecting ones.
winding[poly_, pt_] :=
Round[(Total@
Mod[(# - RotateRight[#]) &@(ArcTan @@ (pt - #) & /@ poly),
2 Pi, -Pi]/2/Pi)]
cross[e1_, e2_] /; (N[Det[{Subtract @@ e1, Subtract @@ e2}]] === 0.) =
...
20
Update
With the approach described in detail below and the function given by J. M. in his answer, we can additionally introduce points to the lines which vary randomly in their size. This gives the look and feel of a pen not drawing with constant thickness due to outrunning ink:
ParametricPlot[{{Cos[t] (2 + 7 Cos[2 t] - Cos[4 t])/8, Sin[t]^3 (3 - 2 Cos[2 ...
19
There are many ways to proceed, the best one uses FrobeniusSolve :
I
Since we know, that
a x + b == y /. Solve[{-4 a + b == 11, 16 a + b == -1}, {a, b}] // Simplify
{3 x + 5 y == 43}
we find
FrobeniusSolve[ {3, 5}, 43]
{{1, 8}, {6, 5}, {11, 2}}
a bit more straightforward way :
II
{x, y} /. Solve[ (a x + b == y /. Solve[ {-4 a + b == 11, 16 ...
19
Mathematica wouldn't be much helpful if one applied only formulae calculated by hand.
Here we demonstrate how to calculate the desired geometric objects with the system having a definition of the curve r[t] :
r[t_] := {t, t^2, t^3}
now we call uT the unit tangent vector to r[t]. Since we'd like it only for real parameters we add an assumption to Simplify ...
18
The idea is quite simple:
Since any great circle can be parametrized as $\cos(\theta)u + \sin(\theta)v$ where $u$ and $v$ are two orthonormal vectors. One can start with $u=\{1,0,0\}, v=\{0,1,0\}$ and use RotationTransform to get out of the xy plane, then use RotationTransform again to spin around the z-axis to get all great circles with desired inclination.
...
15
General remarks
In General Relativity we work in a 4-dimentional Lorentzian manifold i.e. there is a metric tensor $g$ of signature $(+,-,-,-)$ or $(-,+,+,+)$. Theses signatures are mathematically equivalent and we choose the latter because of certain quite formal aspects even though there are some physically relevant reasons for choosing the former one. In ...
14
Here's one way to implement Yves's suggestion:
(* arclength function *)
trefarc = \[FormalS] /. First[NDSolve[
{\[FormalS]'[t] == Norm[KnotData[{3, 1}, "SpaceCurve"]'[t]], \[FormalS][0] == 0},
\[FormalS], {t, 0, 2 Pi}, Method -> "Extrapolation"]]
(* length of trefoil *)
end = trefarc[2 Pi];
With[{n = 25}, (* n - number of points to ...
13
To answer your first question: when in doubt, fall back to basic construction geometry. Fix two points arbitrarily, and "construct" the third by finding the point of intersection of two circles with these points as centers and radii as the sides. Example:
sideAB = 4;sideBC = 5;sideCA = 6;
ptA = {0, 0};ptB = ptA + {sideAB, 0};
ptC = {x, y} /. Last@Solve[x^2 ...
13
I am not aware of any built-in functionality (I might easily be wrong), but there's an example at MathWorld for calculating intersections of convex polygons. You'd need to approximate the circle with a polygon.
Get the notebook from that page: there's an intersection calculation inside that uses the IMTEK Mathematica supplement.
Example:
<< ...
13
If you want to get complete command over the symbol and make it available to various types of geometrical transformations and text styling, you could use FilledCurve function. If splines work for you, FilledCurve may come handy too. If you have or will install the font Poetica Supp Ornaments mentioned in the comments by @Guillochon, then you could turn the ...
13
As a starting point:
ParametricPlot[{
(* modified hypotrochoid *)
{Cos[t] (2 + 7 Cos[2 t] - Cos[4 t])/8, Sin[t]^3 (3 - 2 Cos[2 t])/4},
(* lemniscate of Bernoulli *)
3/2 {1, Cos[t]} Sin[t]/(1 + Cos[t]^2)},
{t, 0, 2 Pi}, Axes -> None, Background -> ColorData["Legacy", ...
13
Here are three points in space.
SeedRandom[2];
{p1, p2, p3} = {{x1, y1, z1}, {x2, y2, z2}, {x3, y3, z3}} =
RandomReal[{-3, 3}, {3, 3}];
If the center is $p=(x,y,z)$ and the radius is $r$, then the distance from $p$ to each $p_i$ must be exactly $r$. Thus, for each $i=1,2,3$, we have
$$(x - x_i)^2 + (y - y_i)^2 + (z - z_i)^2 = r^2.$$
Furthermore, ...
13
Here is a static solution to the problem. It shows a mesh on the sphere that represents the normal lat-long coordinate system.
A function representing the equator.
equator[θ_] := {Cos[θ], Sin[θ], 0}
A function and a plot representing the inclined circle. Note that the inclination is accomplished by a rotation of the equator about the x-axis.
...
13
Is this what you are searching for?
a = {-4, 11};
b = {16, -1};
dy = (b[[2]] - a[[2]])/(b[[1]] - a[[1]]);
offset = u /. Solve[a[[2]] == dy*a[[1]] + u, u][[1]];
coords = {x,
y} /. {Reduce[y == dy*x + offset && x > 0 && y > 0, {x, y},
Integers] // ToRules}
(* {{1, 8}, {6, 5}, {11, 2}} *)
Graphics[{PointSize[Large], ...
13
Using my solution to a similar question asked on StackOverflow some time ago,
Pick[dalist,UnitStep[criticalRadius^2-Total[(Transpose[dalist]-frameCenter)^2]],0]
which is for any number of (Euclidean) dimensions and should be quite fast.
EDIT
Ok, here is a generalization of the vectorized approach I proposed:
ClearAll[cutHole];
cutHole[relativeData_, ...
12
Straight segments
I'll assume you want to fix the first and last point and then plot the segments. Quick and dirty approach (I'll fix the first point at $x=0$ and the last at x=upVal; also note that actually nSeg isn't the number of segments here, but never mind):
upVal = 6;
nSeg = 10;
chordL = Table[
Sqrt[(x[i + 1] - x[i])^2 + (f[x[i + 1]] - ...
12
How about RegionPlot?
RegionPlot[
{
(x - 0.2)^2 + y^2 < 0.5 && 0 < x < 1 && 0 < y < 1,
(x - 0.2)^2 + y^2 < 0.5 && ! (0 < x < 1 && 0 < y < 1),
! ((x - 0.2)^2 + y^2 < 0.5) && 0 < x < 1 && 0 < y < 1
},
{x, -1, 1.5}, {y, -1, 1.5},
PlotStyle -> ...
12
I assume (sorry if I'm being wrong) that this is some kind of homework. So I've written an answer as guidance. You'll have to work out some details.
If your problem is three dimensional, you can write for example:
dist[x0_,x1_] := (x0-x1).(x0-x1);
power[x0_,x1_]:= c/dist[x0,x1];
findAnt[{{pow1_,pos1_},{pow2_,pos2_},{pow3_,pos3_}}]:=
...
11
Minimalist:
k[t_] := KnotData[{3, 1}, "SpaceCurve"][t];
len[r_] := N@Integrate[Total[D[k[t], t]^2], {t, 0, r}];
pts[n_] := Solve[len[t1] == len[2 Pi] #/n, t1, Reals] & /@ Range[n + 1];
Graphics3D@Tube[k[t1] /. # & /@ (Flatten@pts@30), .1]
11
You can also use InterpolatingPolynomial with Solve, Reduce or Eliminate:
a = {-4, 11}; b = {16, -1};
coords = Solve[y == InterpolatingPolynomial[{a, b}, x] && 0 <= x <= 16&&0<=y,
{x, y}, Integers][[All, All, 2]];
(* or *)
coords={ToRules[Reduce[ y == InterpolatingPolynomial[{a, b}, x] &&
0 <= x <= ...
10
This numerical approach is based on length of chord (not arc), so it is a good approximation as long as the curve is smooth and you have close points. You have a parametric curve f of variable t. Define a numerical function that given ti finds such tf that Norm[f[tf]-f[ti]] stays constant. You need 2 functions to keep both negative and positive roots which ...
10
I'm not sure how to draw a triangle if all I care about is the length of the sides. (I'm happy to place one of the vertices at the origin and place one of the sides on the nonnegative side of the $x$-axis, but that doesn't really matter.) Is there a straightforward way?
Given a triangle with side lengths $p \leq q \leq r$ (assuming the lengths satisfy ...
10
This seems too simple to really be what you're asking but perhaps:
recs = {{144, 1}, {72, 2}, {48, 3}, {36, 4}, {24, 6}, {18, 8}, {16,
9}, {12, 12}, {9, 16}, {8, 18}, {6, 24}, {4, 36}, {3, 48}, {2,
72}, {1, 144}};
Rectangle[-#/2, #/2] & /@ recs // Graphics
You should also look at Divisors.
10
This is based on @Mr.Wizard answer , just trying to improve presentation:
First of all you can find all your sides as:
recs = {a, b} /. Solve[a b == 144 && a > 0 && b > 0, Integers];
Then lets clearly distinguish rectangles:
Manipulate[Graphics[{EdgeForm[{Opacity[.2], Thickness[.001], Black}], Blue,
Opacity[op], Rectangle[-#/2, ...
10
Using the parametric equation of the lines.
point = {8, 15}
lines = {{{20, 10}, {11, 27}}, {{11, 27}, {1, 27}}}
distance[{start_, end_}, pt_]:= Module[{param = ((pt - start).(end - start))/Norm[end - start]^2},
EuclideanDistance[pt, start + Clip[param , {0, 1}] (end - start)]];
Min[distance[#, point] & /@ lines]
...
9
It seems I understood your requirement somewhat differently from others, so this is what I came up with:
GraphicsGrid[{Graphics@Rectangle[{0, 0}, #] & /@ c}]
Graphics[Rectangle[…]] plots each rectangle in list c, without any consideration for alignement. Then let GraphicsGrid do the alignment for you…
Edit: and I can has color too:
9
Try!
Graphics[{EdgeForm[Black], FaceForm[Hue[RandomReal[]]],
Rectangle[{0, 0}, #]} & /@ c, Frame -> True,
GridLines -> Automatic, GridLinesStyle -> Directive[Orange, Dashed]]
9
Right from the documentation of ShearingMatrix, that is a GeometricTransformation:
Graphics3D[{GeometricTransformation[{Opacity[.85], Red, Cuboid[]},
ShearingMatrix[Pi/4, {1, 0, 0}, {-1, 1, 0}]]}, Boxed -> False]
A dynamic manipulator to understand arguments:
Manipulate[
Graphics3D[{
GeometricTransformation[{Opacity[.85], Red, Cuboid[]},
...
9
This question of determining whether points form a circle or not can be resolved by solving two sub-problems:
Express the points with just two coordinates rather than $n=3$.
Test whether a collection of points in a plane is concyclic.
We might as well solve the first sub-problem for dimensions $n\ge 3$, because it all works the same: we find an ...
Only top voted, non community-wiki answers of a minimum length are eligible
