archery

click through for high-res: 500x500

Randomly generated with Mathematica code:

F[r_, a_, s_, p_] :=
 Table[
  Graphics[
   GraphicsComplex[
    Table[
     {-(r^n)*Sin[n*a], r^n*Cos[n*a]}, {n, 0, s}],
    {If[G == 1, White, Black], Polygon[Table[i, {i, 1, s, 1}]]}], 
   PlotRange -> p, ImageSize -> 500, 
   Background -> If[G == 0, White, Black]],
  {G, {0, 1}}]

Manipulate[
  F[r, a, s, p],
{{p, 1}, .0001, 1, .001}, {{r, 1}, .95, 1}, {{a, 2.8}, 0.001, 4Pi, .00001}, {{s, 300}, 1, 1000, 1}]

 ListAnimate[F[r, a, s, p], 20, AnimationRunning->False]

Notes: 42 5/17/12 — 9:07pm Filed under: #2color #2frame #CTD #GIF #Mathematica #epilepsy warning

Consider a 2-coloring of some region and its complement:

They are the same except that the black and white colors have been interchanged. Recall that these are the only possible 2-colorings for this partition.

By construction, for any planar 2-coloring, if the two images are displayed at the same time by overlaying the two images and treating white as a transparent color, then a region in all black results

… nothing too interesting.

Instead, displaying the two images in rapid succession creates a dynamic strobe effect.

Its like you can start with nothing, divide it into things which are still and inert when taken individually, yet end up with something dynamic and alive when taken together.

Mathematica code:

F[ a_, s_, p_] :=
 Table[
  Graphics[
   GraphicsComplex[
    Table[
     {-Sin[n*a], Cos[n*a]}, {n, 0, s}],
    {If[G == 1, White, Black], Polygon[Table[i, {i, 1, s, 1}]]}], 
   PlotRange -> p, ImageSize -> 500, 
   Background -> If[G == 0, White, Black]],
  {G, {0, 1}}]

Manipulate[
  F[ a, s, p],
{{p, 1}, .0001, 1, .001}, {{a, 2.8}, 0.001, 4Pi, .00001}, {{s, 300}, 1, 1000, 1}]

 ListAnimate[F[a, s, p], 20, AnimationRunning->False]

Notes: 34 5/16/12 — 6:31pm Filed under: #GIF #2color #2frame #CTD #Mathematica #epilepsy warning #wisdom

view GIFs in hi-res here (700x700)

Mathematica code:

F[a_, L_, r_, s_, t_] :=
 Table[
  {-(r + s*Cos[t])^n*Sin[n*a], (r + s*Cos[t])^n*Cos[n*a]}, {n, 0, L}]

V := 
 {{1.45631, 556, .995, .003}, {2.94712, 502, .998, .001}, 
 {4.50891, 485, .9955, .0025}, {4.9367, 630, .997, .002}}

Table[
 ListAnimate[
  Table[
   Graphics[
    Polygon[
     F[Part[Part[V, G], 1], Part[Part[V, G], 2], Part[Part[V, G], 3], Part[Part[V, G], 4], t]], 
   PlotRange -> 1, ImageSize -> 250],
 {t, 0, 2 Pi, 2 Pi/40}]],
{G,1,4,1}

Notes: 229 5/10/12 — 6:18pm Filed under: #2color #CTD #GIF #Mathematica #photoset

hi-res GIFs (700x700)

Mathematica code:

F[a_, L_, r_, s_, t_] :=
 Table[
  {-(r + s*Cos[t])^n*Sin[n*a], (r + s*Cos[t])^n*Cos[n*a]}, {n, 0, L}]

V := 
 {{1.45631, 556, .995, .003}, {2.94712, 502, .998, .001}, 
 {4.50891, 485, .9955, .0025}, {4.9367, 630, .997, .002}}

Table[
ListAnimate[
 Table[
  Graphics[
   Polygon[
    F[Part[Part[V, G], 1], Part[Part[V, G], 2], Part[Part[V, G], 3], Part[Part[V, G], 4], t]], 
   PlotRange -> 1, ImageSize -> 700],
  {t, 0, 2 Pi, 2 Pi/40}]], 
{G,1,4,1}

PRINT THIS POST Notes: 14 5/10/12 — 6:02pm Filed under: #GIF #Mathematica #2color #CTD

$Mathematica code: ListAnimate[ Table[Show[ Table[Graphics[ GraphicsComplex[ Table[ {-(.975 + .025*Mod[.5 t + .5 G, 1])^n*Sin[n*3.586], (.975 + .025*Mod[.5 t + .5 G, 1])^n*Cos[n*3.586]}, {n, 0, 416}], {Opacity[(G +(.3+ t) (-1)^G)], Polygon[Table[i, {i, 1, 416, 1}]]}], PlotRange -> .04, ImageSize -> 500], {G, {0, 1}}]],{t, 0, .95, .05}]]$

Mathematica code:

ListAnimate[
 Table[Show[
   Table[Graphics[
     GraphicsComplex[
      Table[
       {-(.975 + .025*Mod[.5 t + .5 G, 1])^n*Sin[n*3.586],
          (.975 + .025*Mod[.5 t + .5 G, 1])^n*Cos[n*3.586]},
      {n, 0, 416}],
    {Opacity[(G +(.3+ t) (-1)^G)], Polygon[Table[i, {i, 1, 416, 1}]]}], 
    PlotRange -> .04, ImageSize -> 500],
  {G, {0, 1}}]],
{t, 0, .95, .05}]]

Notes: 546 5/9/12 — 5:00pm Filed under: #GIF #Mathematica #2color #CTD

$A 2-coloring of what results from playing connect-the-dots with the complex numbers zn, for 0 < n < 140, as z varies from ei2.9531 to ei2.96104. Mathematica code: ListAnimate[Table[ Graphics[ GraphicsComplex[ Table[ {-1^n*Sin[n*a], 1^n*Cos[n*a]}, {n, 0, 139}], Polygon[Table[i, {i, 1, 139, 1}]]], PlotRange -> .55, ImageSize -> 500],{a, 2.9531, 2.96104, .00026}]]$

A 2-coloring of what results from playing connect-the-dots with the complex numbers zⁿ, for 0 < n < 140, as z varies from e^i2.9531to e^i2.96104.

Mathematica code:

ListAnimate[
Table[
  Graphics[
   GraphicsComplex[
     Table[
      {-1^n*Sin[n*a], 1^n*Cos[n*a]}, 
     {n, 0, 139}],
   Polygon[Table[i, {i, 1, 139, 1}]]], 
  PlotRange -> .55, ImageSize -> 500],
{a, 2.9531, 2.96104, .00026}]]

Notes: 382 5/8/12 — 4:00pm Filed under: #GIF #Mathematica #2color #CTD

A 2-coloring by psykzz

Source: psykzz

Notes: 1112 5/7/12 — 10:01pm Filed under: #GIF #2coloring #CTD #psykzz

$A 2-coloring of what results from playing connect-the-dots with the complex numbers zn, for 0 < n < 100, as z varies from ei2.595 to ei2.599. Mathematica code: ListAnimate[Table[ Graphics[ GraphicsComplex[ Table[ {-1^n*Sin[n*a], 1^n*Cos[n*a]}, {n, 0, 100}], Polygon[Table[i, {i, 1, 100, 1}]]], PlotRange -> .65, ImageSize -> 500],{a, 2.59523, 2.59994, .00015}]]$

A 2-coloring of what results from playing connect-the-dots with the complex numbers zⁿ, for 0 < n < 100, as z varies from e^i2.595 to e^i2.599.

Mathematica code:

ListAnimate[
Table[
  Graphics[
   GraphicsComplex[
    Table[
     {-1^n*Sin[n*a], 1^n*Cos[n*a]}, {n, 0, 100}],
    Polygon[Table[i, {i, 1, 100, 1}]]], 
  PlotRange -> .65, ImageSize -> 500],
{a, 2.59523, 2.59994, .00015}]]

Notes: 167 5/7/12 — 5:00pm Filed under: #GIF #Mathematica #CTD #2coloring

Planar 2-colorability

Take some region of the plane, and any number of distinct lines that pass anywhere through this region. Consider these random lines for instance:

Notice how the lines and their crossings create polygonal shapes in the region.

Using just two colors, say black and white, is it possible to color the entire region such that any two polygons that are next to each other sharing a common edge are different colors?

This is possible in the above example as this 2-coloring indicates:

There is also another possible 2-coloring that satisfies these requirements, but its really just the same as the 2-coloring above with the colors switched.

You can convince yourself that these are the only two permissible 2-colorings meeting the criterion with this particular configuration of lines.

One may wonder if its always possible to achieve such a 2-coloring, or precisely under what circumstances it is or is not possible.

It does seem to be the case that if each line passes completely through the region, then a 2-coloring will always be possible.

The following examples show this for two particular cases, where not only are there a different number of randomly chosen lines in each case, but each line is even allowed to move. Regardless, at each instance, the 2-coloring is always preserved!

Still, these examples do not prove the claim in general since there remains an infinite number of cases left unconsidered. How would one prove this?

Well, when would such a 2-coloring not be possible?

At any intersection of lines in the region, the crossings create corners for the polygons that are formed. If there happens to be an intersection with an odd number of corners, then for any assignment of 2 colors to the parts around this intersection, there would have to exist two adjacent parts that have the same color. Otherwise, for an even number of corners around an intersection, it is always possible to assign a 2-coloring so that adjacent parts have different colors.

Therefore, as long as all the intersections formed within the region have an even number of corners, there will exist a 2-coloring. This criterion will be met if we assume that the lines always pass completely through the region as in previous considerations

These conditions are special and do limit the possible configurations that are 2-colorable.

What if configurations were allowed to have intersections with an odd number of corners?

What if lines didn’t have to pass completely through the region and were allowed to end somewhere inside of it?

What if we didn’t have to use straight lines to partition the region?

If it is not possible to color the region in the above sense with 2 colors, how many would it take?

Does there exist some maximum finite number of colors that can be used to color any possible partition of a region?

The 4-color theorem, first stated in 1852, which concerns the problem under consideration, states that only 4 colors are needed to color any configuration so that adjacent regions are not colored the same.

The truth of this theorem went without correct proof until 1976 when it was proved by Kenneth Appel and Wolfgang Haken using a computer! This computer-assisted proof may be considered controversial and has interesting implications.

It is worth mentioning that the related problem of deciding whether a given configuration is 2-colorable is easy to solve since there are efficient computer algorithms that can check. However, the problem of deciding if 3 colors are needed is hard to do in general since there are currently no known computers algorithms that can efficiently solve this problem.

If you can find a fast algorithm, or if it you can prove that no efficient algorithm can exist for deciding the 3-coloring problem, then you could win $1,000,000 solving a big open problem in computer science.

PRINT THIS POST Notes: 126 5/4/12 — 7:30pm Filed under: #GIF #Mathematica #complexity theory #math #P vs NP #2coloring

$Mathematica code: P[t_, u_] := Mod[t + 10 u, 31]Op[t_, u_] := If[-1 < P[t, u] < 21 - 10 u, 1, If[20 - 10 u < P[t, u] < 31, 3 - .1P[t, u] - 1 u, 0]]ListAnimate[ Table[ Show[ Table[ Graphics[ Table[ {Thickness[.002], Opacity[Op[t, u]], White, Circle[ {-.987^n*Sin[n*6], .987^n*Cos[n*6]}, .985^n*.03*P[t, u]]}, {n, 0, 150}], PlotRange -> .5, ImageSize -> 500, Background -> Black], {u, 0, 1, 1}]], {t, 1, 30, 1}]]$

Mathematica code:

P[t_, u_] := Mod[t + 10 u, 31]

Op[t_, u_] := 
 If[-1 < P[t, u] < 21 - 10 u, 1, 
  If[20 - 10 u < P[t, u] < 31, 3 -  .1P[t, u] - 1 u, 0]]

ListAnimate[
 Table[
  Show[
   Table[
    Graphics[
     Table[
      {Thickness[.002], Opacity[Op[t, u]], White,
       Circle[
        {-.987^n*Sin[n*6], .987^n*Cos[n*6]}, .985^n*.03*P[t, u]]},
     {n, 0, 150}],
    PlotRange -> .5, ImageSize -> 500, Background -> Black],
   {u, 0, 1, 1}]],
 {t, 1, 30, 1}]]

Notes: 172 4/25/12 — 5:01pm Filed under: #GIF #Mathematica

$Mathematica code: ListAnimate[ Table[ ImageCrop[ Graphics[ {Opacity[1, White], Line[ Table[ {-.99^n*Sin[n*.533], .99^n*Cos[n*.533]}, {n, 0, 700}]]}, PlotRange -> p, ImageSize -> 700, Background -> Black], {500, 700}],{p, 0.1637, .4711, .01}]]$

Mathematica code:

ListAnimate[
 Table[
  ImageCrop[
   Graphics[
    {Opacity[1, White],
     Line[
      Table[
       {-.99^n*Sin[n*.533], .99^n*Cos[n*.533]},
      {n, 0, 700}]]},
    PlotRange -> p, ImageSize -> 700, Background -> Black],
 {500, 700}],
{p, 0.1637, .4711, .01}]]

Notes: 631 4/23/12 — 7:27pm Filed under: #GIF #Mathematica #CTD

$Mathematica code: P[t_] := (1 + 0.9 Cos[8 t]) (1 + 0.1 Cos[24 t]) (0.9 + 0.05 Cos[200 t]) (1 + Sin[t])T[t_] := If[0 < t < 17, .01 t, If[16 < t < 25, .2 + .1 (t - 16)/2, If[24 < t < 35, 0 + (t - 24)/2, If[34 < t < 45, -3 + 20*(t - 34)/2, 0]]]]ListAnimate[ Table[ Show[ PolarPlot[ Evaluate[ Table[ (T[Mod[s, 45]]*1/.85^n)*C[t], {n, 0, 20, 1}], {t, -Pi, Pi}], PlotRange -> {{-7.5, 7.5}, {-4.3, 15.7}}, Background -> Black, Axes -> False, ImageSize -> 500], PolarPlot[ Evaluate[ Table[ (T[Mod[s + 5, 45]]*1/.85^n)*C[t], {n, 0, 20, 1}], {t, -Pi, Pi}], PlotRange -> {{-7.5, 7.5}, {-4.3, 15.7}}, Background -> Black]],{s, 1, 45, 2}]]$

Mathematica code:


P[t_] := (1 + 0.9 Cos[8 t]) (1 + 0.1 Cos[24 t]) (0.9 + 0.05 Cos[200 t]) (1 + Sin[t])

T[t_] := 
 If[0 < t < 17, .01 t, 
  If[16 < t < 25, .2 + .1 (t - 16)/2, 
   If[24 < t < 35, 0 + (t - 24)/2, 
    If[34 < t < 45, -3 + 20*(t - 34)/2, 0]]]]

ListAnimate[
 Table[
  Show[

   PolarPlot[
    Evaluate[
     Table[
      (T[Mod[s, 45]]*1/.85^n)*C[t],
      {n, 0, 20, 1}],
    {t, -Pi, Pi}], 
   PlotRange -> {{-7.5, 7.5}, {-4.3, 15.7}}, 
   Background -> Black, Axes -> False, ImageSize -> 500],

   PolarPlot[
    Evaluate[
     Table[
      (T[Mod[s + 5, 45]]*1/.85^n)*C[t],
      {n, 0, 20, 1}],
    {t, -Pi, Pi}], 
  PlotRange -> {{-7.5, 7.5}, {-4.3, 15.7}}, 
  Background -> Black]],

{s, 1, 45, 2}]]

Notes: 3037 4/20/12 — 10:52pm Filed under: #420 #GIF #Mathematica #IFS

In hopes of making this blog more well rounded for the likes of Tumblr, graphed above is a plot resembling the shape of a cannabis leaf.

It is given by the following equation in polar form:

or as a parametric curve in Cartesian coordinates as

Open problems: rigorously defining pizza and cats using mathematics.

Mathematica code:

ListAnimate[
 Table[
  PolarPlot[
   (1 + .9 Cos[8 *t]) (1 + .1 Cos[24 t]) (.9 + .05*Cos[200 t]) (1 + Sin[t]), 
   {t, 3 Pi/2 - T, 3 Pi/2 + T}, 
  PlotRange -> {{-2.5, 2.5}, {-.5, 4}}, PlotStyle -> {Green}, 
  AxesStyle -> Directive[White], Background -> Black, ImageSize -> 500], 
{T, Pi/60, Pi, Pi/60}]]

Notes: 76 4/20/12 — 4:21pm Filed under: #420 #GIF #Mathematica #math #polar plot

Connecting the dots in the complex plane

This will be an attempt at describing the algorithmic procedure used to generate some of the graphics posted here.

Start with a line segment of any length L.
Now pick any angle A in the range 0° to 180°.
Connect another line segment of the same length as the first at the end of the first line so that two create an angle of A between them.
Repeat this procedure connecting additional lines of length L at the same angle A to the endpoints of the previous lines.

This shows the procedure repeated several times using an angle of about 20°.

And this shows the pattern that results some 150 lines into the procedure with the same angle of 20°:

Instead, if each additional line segment were to be made slightly smaller than the previous, say 99% of the length of the previous line, then the lines would look something like this where they begin to spiral in towards the center:

Its interesting to observe how these patterns change as the value for the angle A is varied. The closer the values for two different angles are the closer the two patterns will resemble one another. However, for each distinct angle A the resulting pattern is unique.

Here are some animations that show the angle vary through some range while keeping the number of lines in the iteration fixed. Note how relatively small the range is that the angle varies through.

With all lines the same length varying through angles of about 10.7° to 10.4° :

and with each line 99% the length of the previous with an angle variation from 20° to 16° :

This algorithm can be equivalently thought of as taking a certain ordered sequence of points in the plane and then joining them with straight lines—playing connect the dots basically. Different arrangements and sequences of points in the plane would produce different patterns when connected with lines.

Perhaps the most elegant and concise way to mathematically describe this algorithm is by making use of the complex numbers. Due to the way complex numbers multiply, this algorithm can be specified by picking a complex number z and then successively multiplying it by itself to get a sequence of points given by zⁿ, where the resulting complex numbers zⁿ represent the nth point in the sequence. Then the connect the dots routine is performed with this sequence of points.

For instance, the configuration for the first 100 dots corresponding to a particular choice of complex number may look something like this:

Then once all the dots are connected with lines it would look like this:

Performing this procedure with each different point in the complex plane generates a different pattern.

This kind of procedure where a certain transformation is repeated on some elements is considered an iterated function system, which is a class of fractals.

You could imagine all the different possibilities which would result from using different functions.

In fact, all of these images here were generated using similar procedures.

Download an interactive CDF file here where you can control the parameters, view the graphics, and also create numbered dot sequences.

PRINT THIS POST Notes: 186 4/19/12 — 5:00pm Filed under: #CTD #GIF #IFS #Mathematica #math #CDF

view GIFs in high-res (700x700) here

Mathematica code:

Table[
 ListAnimate[
  Table[
   Graphics[
    {White, Line[
     Table[
      {-.99^n*Sin[n*a], .99^n*Cos[n*a]},
     {n, 0, 700}]]},
   PlotRange -> 1, ImageSize -> 250, Background -> Black],
 {a, 2 Pi/p, 2 Pi/(p + 1), (2 Pi/(p + 1) - 2 Pi/p)/75}]],
{p, 3, 6, 1}]

Notes: 797 4/10/12 — 5:01pm Filed under: #GIF #Mathematica #photoset #CTD