# Tag Info

76

cow = ExampleData[{"Geometry3D", "Cow"}]; Manipulate[cow /. GraphicsComplex[array1_, rest___] :> GraphicsComplex[(# (Norm[#]^-coeff)) & /@ array1, rest], {{coeff, .25}, 0, 1}] Edit To answer to Clément's comment, here is same thing with constant plot range :

67

We can do this by building a regular hexagon tile and wrapping it onto a torus: hexTile[n_, m_] := With[{hex = Polygon[Table[{Cos[2 Pi k/6] + #, Sin[2 Pi k/6] + #2}, {k, 6}]] &}, Table[hex[3 i + 3 ((-1)^j + 1)/4, Sqrt/2 j], {i, n}, {j, m}] /. {x_?NumericQ, y_?NumericQ} :> 2 π {x/(3 m), 2 y/(n Sqrt)} ] ht = With[{...

55

TL;DR Yes, this can be done! If you read the article "Hexagonal circle packings and Doyle spirals" by Leys, you will see that for a choice p and q, we need to find the complex values A, B and r. For that purpose, we can steal this part from the demonstration you linked: doyle[pi_, qi_] := Module[{p = pi, q = qi, s, t, r}, r[s_, t_, p_, q_] := (s^2 + ...

49

Edit: added Gradient -> grad[vars] option. Without this small option the code was several orders of magnitude slower. Yes, it can! Unfortunately, not automatically. There are different algorithms to do it (see special literature, e.g. Dziuk, Gerhard, and John E. Hutchinson. A finite element method for the computation of parametric minimal surfaces. ...

48

I propose a small modification of the parametrization for the torus that addresses issues with conformality. Try F[t_, u_, r_] := {Cos[t] (r + Cos[u + Sin[u]/r]), Sin[t] (r + Cos[u + Sin[u]/r]), Sin[u + Sin[u]/r]} instead. Next, we wish to choose suitable values for $m, n$ for a given $r$ such that the mapping of the ...

46

My approach. The main distinguishing feature being the ridiculously clumsy and inefficient way of calculating the faces... v = Tuples[{-1, 1}, 4]; e = Select[Subsets[Range[Length[v]], {2}], Count[Subtract @@ v[[#]], 0] == 3 &]; f = Select[Union[Flatten[#]] & /@ Subsets[e, {4}], Length@# == 4 &]; f = f /. {a_, b_, c_, d_} :> {b, a, c, d}; rotv[...

46

To answer your question: I don't think it's a bad or good idea to use If. It depends on how you do it. To demonstrate I'll use If combined very powerfully with Mathematica 10's ability to tell if a point is inside a specified region or not. step[position_, region_] := Module[{randomStep}, randomStep = RandomChoice[{{-1, 0}, {1, 0}, {0, -1}, {0, 1}}]; If[...

43

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 ...

42

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 ...

40

A basic approach You can start with a regular density plot, restricted to the domain of x and y using RegionFunction. Then you can transform the plot to an equilateral triangle. f[p_, q_, r_] := r Sin[10 p]^2 + (1 - r) r Cos[20 q]^2; dp = DensityPlot[f[x, y, 1 - x - y], {x, 0, 1}, {y, 0, 1}, RegionFunction -> (#1 <= 1 - #2 &), ColorFunction -&...

40

Version 11 has both symbolic and numeric eigensolvers, see here for an overview Here is a slightly different way to do it. We write a function that converts any PDE (1D/2D/3D) into discretized system matices: Needs["NDSolveFEM"] PDEtoMatrix[{pde_, Γ___}, u_, r__, o : OptionsPattern[NDSolve`ProcessEquations]] := Module[{ndstate, feData, sd, bcData, ...

39

p1 = {Sin[t], Cos[t]}; p2 = {Cos[3 t], Sin[2 t]}; tAtMin = ArgMax[{EuclideanDistance[p1, p2]^2, 0 <= t <= 2 Pi}, t] tAtMax = ArgMin[{EuclideanDistance[p1, p2]^2, 0 <= t <= 2 Pi}, t] ParametricPlot[{p1, p2}, {t, 0, 2 Pi}, Epilog -> {PointSize[0.02], Red, Thick, Dashed, Through[{Point, Line}[{p1, p2} /. t -> tAtMax]], Darker@Green, ...

38

I recreated the animation on Wikipedia: Here is the Manipulate version: R = 3; r = 1; fx[θ_, a_: 1] := (R + r) Cos[θ] - a r Cos[(R + r) θ/r]; fy[θ_, a_: 1] := (R + r) Sin[θ] - a r Sin[(R + r) θ/r]; gridlines = Table[{x, GrayLevel[0.9]}, {x, -6, 6, 0.5}]; plot[max_] := ParametricPlot[ {fx[θ], fy[θ]}, {θ, 0, max}, PlotStyle -> {Red, Thick}, ...

37

Edit V10! This is simple example what we can now do in real time! R = RegionUnion @@ Table[Disk[{Cos[i], Sin[i]}, .4], {i, 0, 2 Pi, Pi/6.}]; R2 = RegionBoundary@DiscretizeRegion@R; go[] := (While[r > .105, x += v; r = RegionDistance[R2, x]; Pause[.01]]; bounce[];) bounce[] := With[{normal = Normalize[x - RegionNearest[R2, x]]}, If[break, Abort[]]; v ...

37

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

Here is my (slightly less) modest attempt to depict the Clifford rotation (a.k.a. double rotation) of a hypercube, using perspective projection (i.e., a Schlegel diagram) to view the rotation (see this for a discussion on perspective projection): tesseract = GraphicsComplex[ {{-1, -1, -1, -1}, {-1, -1, -1, 1}, {-1, -1, 1, -1}, {-1, -1, 1, 1}, {-1, 1, -1, ...

30

Just wanted to update everyone that things are much simpler, - there is built in support for this: MeshFunctions -> {"ArcLength"} So for our case: Show[{ ParametricPlot3D[KnotData[{3, 1}, "SpaceCurve"][t], {t, 0, 2 Pi}, (* the trick *) Mesh -> 15, MeshFunctions -> {"ArcLength"}, (* styles *) MeshStyle -> Directive[Red, ...

30

There is an explicit formula n = 30; m = 10; f[t_, u_] := {Cos[t] (3 + Cos[u]), Sin[t] (3 + Cos[u]), Sin[u]}; Graphics3D[Polygon /@ Table[ f[(4 π)/(3 n) (Cos[π k/3] + i 3/2), (2 π)/(Sqrt m) (Sin[π k/3] + (j + i/2) Sqrt)], {i, n}, {j, m}, {k, 6}]] % /. Polygon -> Tube I find it a bit simpler than rm -rf's solution. Here f transforms from ...

30

The following is based on the fact that the determinant of a matrix is equal to zero when two rows are the same. Thus, if you plug any of the points in, you get a true statement. SeedRandom; pts = RandomReal[{-1, 1}, {5, 2}]; row[{x_, y_}] := {1, x, y, x*y, x^2, y^2}; eq = Det[Prepend[row /@ pts, row[{x, y}]]] == 0 (* Out: 0.0426805-0.0293168x-0....

29

One way to approach is to calculate the basic triangle (with sides of lengths Sqrt[n], Sqrt[n+1] and 1) and then rotate it the correct amount so that they all fit together. sumAng[n_] := Sum[ArcTan[1/Sqrt[i]], {i, 1, n}]; poly[n_] := {{0, 0}, {Sqrt[n + 1], 0}, {Sqrt[n + 1], 1}}; Graphics[Table[Rotate[{Opacity, Hue[RandomReal[]], Polygon[poly[i]]}, ...

28

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 t]...

28

Fixed (see below) Here's an approach: r1 = Exp[-x^3 - y] - 1 == z; r2 = y == z; We create ImplicitRegions: reg1 = ImplicitRegion[r1, {x, y, z}]; reg2 = ImplicitRegion[r2, {x, y, z}]; The intersection of these regions is the line you seek: reg = RegionIntersection[reg1, reg2]; And here is the length (note the inclusion of the range of values in ...

28

Get cow as a mesh region: cow = ExampleData[{"Geometry3D", "Cow"}, "MeshRegion"]; Take coordinates of 0 cells: coords = MeshCoordinates[cow]; Get outer sphere that bounds cow: boundary = RegionBoundary @ BoundingRegion[cow, "MinBall"]; You could also try other bounds like "FastCapsule". For example, boundary = RegionBoundary @ BoundingRegion[cow, "...

27

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 a + b == ...

27

Here is a method that utilizes $H^1$-gradient flows. This is far quicker than the $L^2$-gradient flow (a.k.a. mean curvature flow) or using FindMinimum and friends, in particular when dealing with finely discretized surfaces. Background For those who are interested: A major reason for numerical slowness of $L^2$-gradient flow is the Courant–Friedrichs ...

26

Here are three points in space. SeedRandom; {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, the ...

26

p1 = Partition[{{243.8, 77.}, {467.4, 12.}, {291.8, 130.}, {476., 210.5}, {103.2, 327.}, {245.2, 110.5}, {47.4, 343.}, {87.4, 108.5}, {371., 506.5}, {384.6, 277.}, {264.6, 525.5}, {353.8, 294.5}, {113.2, 484.5}, {296., 304.5}, {459.6, 604.5}, {320.2, 466.5}, {288.2, 630.5}, {199.6, 446.5}, {138.8, 615.5}, {81.8, 410.}, {232.4, 795.}, ...

26

Hyperbolic lines in the Poincare disk are arcs of circles which, if extended, would meet the unit circle boundary orthogonally. Tiling the disk requires reflection of a tile's vertices and circular edges in those same circular edges. This corresponds to inversion in a circle. Begin with a central polygon having p edges, with q such polygons meeting at each ...

25

There is no need to use Eigensystem or Eigenvectors to find the axis of a rotation matrix. Instead, you can read the axis vector components off directly from the skew-symmetric matrix $$a \equiv R^T-R$$ In three dimensions (which is assumed in the question), applying this matrix to a vector is equivalent to applying a cross product with a vector made up ...

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