Posts tagged: density plot

Made in response to a recent question posted at the Mathematica Stack Exchange.

Mathematica code:

img =
ImageCrop@DensityPlot[
Sin[2 x - 20 Log[2 (Sin[y]^2 + 1), 2]],
{x, 0, 16 Pi}, {y, 0, 32 Pi},
PlotPoints -> 250, ColorFunction -> "SunsetColors",
Frame -> False, ImageSize -> 600]LogPolar[x_, y_] := {Log[Sqrt[x^2 + y^2]], ArcTan[x, y]}d = ImageDimensions[img][[1]]
Manipulate[
ImageResize[
ImageTransformation[
ImageTake[
img,
{1, 14*d/16}, {1 + (2 - 2 t)*d/32, (32 - 2 t)*d/32}],
LogPolar[#[[1]], #[[2]]] &, DataRange -> {{-Pi, Pi}, {-Pi, Pi}}],
500],
{t, 0, 6/7, 1/7}]

Mathematica code:

Animate[  DensityPlot[    Cos[Exp[Sqrt[x^2 + y^2]]*Sin[ArcTan[x, y]] + t],     {x, -7, 7}, {y, -7, 7},  PlotPoints -> 150, Mesh -> False, Frame -> False,   ColorFunction -> GrayLevel, ImageSize -> 521],{t, 0, 2 Pi, 2 Pi/10}]
Filed under: #GIF  #Mathematica  #density plot  #drafts  #queued

Music: “Parisian Goldfish (Take Remix)” by Flying Lotus

Watch the rest of the video in sub-par quality here.
When it comes to the rapid movement of unnaturally bright colors Tumblr’s video transcoding seems to work better than both Vimeo’s and YouTube’s!

Mathematica code:

ListAnimate[ Table[  ImageCrop[   DensityPlot[    Sin[(t*.005)*Abs[(x + I y)^2]], {x, -8, 8}, {y, -8, 8},    PlotPoints -> 20, Mesh -> False, Frame -> False,    ColorFunction -> Hue, ImageSize -> 668],   {640, 480}], {t, 0, 1780, 1}]20, AnimationRunning -> False]

Mathematica code:

f[x_, y_] := {Log[Sqrt[(x)^2 + (y)^2]], ArcTan[x, y]}ListAnimate[  Table[    ImageTransformation[     ImageResize[ImageTake[ImageCrop[       DensityPlot[         Sin[104.02*Abs[(x + I y)^2]],        {x, -4.26, 4.26}, {y, -4.26, 4.26}, PlotPoints -> 27,        Mesh -> False, Frame -> False, ColorFunction -> Hue, ImageSize -> 834],     800], {193 - t, 747 - t}, {123 + t, 677 + t}], {500, 500}],    f[#[[1]], #[[2]]] &, DataRange -> {{-Pi, Pi}, {-Pi, Pi}}], {t, 63, 0, 7}],10, AnimationRunning -> False]

High-res: 800x800

Mathematica code:

f[x_, y_] := {Log[Sqrt[x^2 + y^2]], ArcTan[x, y]}ImageTransformation[ ImageCrop[    DensityPlot[       Sin[104.02*Abs[(x + I y)^2]],     {x, -4.26, 4.26}, {y, -4.26, 4.26},     PlotPoints -> 27, Mesh -> False, Frame -> False,     ColorFunction -> Hue, ImageSize -> 834], 800],f[#[[1]], #[[2]]] &, DataRange -> {{-Pi, Pi}, {-Pi, Pi}}]

Mathematica code:

f[x_, y_] := {Log[Sqrt[(x)^2 + (y)^2]], ArcTan[x, y]}ListAnimate[  Table[    ImageTransformation[     ImageResize[ImageTake[ImageCrop[       DensityPlot[         Sin[104.54*Abs[(x + I y)^2]],        {x, -2.5, 2.5}, {y, -2.5, 2.5}, PlotPoints -> 27,        Mesh -> False, Frame -> False, ColorFunction -> Hue, ImageSize -> 834],     800], {100 + t, 700 + t}, {100 - t, 700 - t}],{500, 500}],    f[#[[1]], #[[2]]] &, DataRange -> {{-Pi, Pi}, {-Pi, Pi}}], {t, 0, 90, 10}],10, AnimationRunning -> False]

High-res: 800x800

Mathematica code:

f[x_, y_] := {Log[Sqrt[x^2 + y^2]], ArcTan[x, y]}ImageTransformation[ ImageCrop[    DensityPlot[       Sin[104.54*Abs[(x + I y)^2]],     {x, -2.5, 2.5}, {y, -2.5, 2.5},     PlotPoints -> 27, Mesh -> False, Frame -> False,     ColorFunction -> Hue, ImageSize -> 834], 800],f[#[[1]], #[[2]]] &, DataRange -> {{-Pi, Pi}, {-Pi, Pi}}]

Mathematica code:

f[x_, y_] := {Log[Sqrt[(x)^2 + (y)^2]], ArcTan[x, y]}ListAnimate[  Table[    ImageTransformation[     ImageResize[ImageTake[ImageCrop[       DensityPlot[         Sin[84.74*Abs[(x + I y)^2]],        {x, -10, 10}, {y, -10, 10}, PlotPoints -> 35,        Mesh -> False, Frame -> False, ColorFunction -> Hue, ImageSize -> 834],    800], {119 + t, 683 + t}, {189 - t, 753 - t}],{500, 500}],   f[#[[1]], #[[2]]] &, DataRange -> {{-Pi, Pi}, {-Pi, Pi}}], {t, 65, 0, 5}],10, AnimationRunning -> False]

High-res: 800x800

Mathematica code:

f[x_, y_] := {Log[Sqrt[x^2 + y^2]], ArcTan[x, y]}ImageTransformation[ ImageCrop[   DensityPlot[     Sin[84.74*Abs[(x + I y)^2]],    {x, -10, 10}, {y, -10, 10},    PlotPoints -> 35, Mesh -> False, Frame -> False,    ColorFunction -> Hue, ImageSize -> 834], 800],f[#[[1]], #[[2]]] &, DataRange -> {{-Pi, Pi}, {-Pi, Pi}}]

High-res: 800x800

Mathematica code:

ImageCrop[  DensityPlot[    Sin[84.74*Abs[(x + I y)^2]],   {x, -10, 10}, {y, -10, 10},   PlotPoints -> 35, Mesh -> False, Frame -> False,   ColorFunction -> Hue, ImageSize -> 944],800]
Filed under: #Mathematica  #density plot

Type 2) form constant: spiral

Mathematica code:

Diagonals[t_] := ImageCrop[   DensityPlot[     Cos[x + y - t*Pi/5],   {x, -20 Pi, 20 Pi}, {y, -20 Pi, 20 Pi},   PlotPoints -> 100, Mesh -> False, Frame -> False,    ColorFunction -> GrayLevel, ImageSize -> 522], 500]ListAnimate[  Table[   Diagonals[t],  {t, 0, .9, .1}]]f[x_, y_] := {Log[Sqrt[(x)^2 + (y)^2]], ArcTan[x, y]}ListAnimate[  Table[    ImageTransformation[      Diagonals[t],    f[#[[1]], #[[2]]] &, DataRange -> {{-Pi, Pi}, {-Pi, Pi}}],  {t, 0, .9, .1}]]

Type 1) form constant: rays

Mathematica code:

HStripes[t_] := ImageCrop[   DensityPlot[     Cos[y - t*Pi/5],   {x, -20 Pi, 20 Pi}, {y, -20 Pi, 20 Pi},   PlotPoints -> 100, Mesh -> False, Frame -> False,    ColorFunction -> GrayLevel, ImageSize -> 522], 500]ListAnimate[  Table[   HStripes[t],  {t, 0, .9, .1}]]f[x_, y_] := {Log[Sqrt[(x)^2 + (y)^2]], ArcTan[x, y]}ListAnimate[  Table[    ImageTransformation[      HStripes[t],    f[#[[1]], #[[2]]] &, DataRange -> {{-Pi, Pi}, {-Pi, Pi}}],  {t, 0, .9, .1}]]

Type 1) form constant: tunnel

Mathematica code:

VStripes[t_] := ImageCrop[   DensityPlot[     Cos[x - t*Pi/5],   {x, -20 Pi, 20 Pi}, {y, -20 Pi, 20 Pi},   PlotPoints -> 100, Mesh -> False, Frame -> False,    ColorFunction -> GrayLevel, ImageSize -> 522], 500]ListAnimate[  Table[   VStripes[t],  {t, 0, .9, .1}]]f[x_, y_] := {Log[Sqrt[(x)^2 + (y)^2]], ArcTan[x, y]}ListAnimate[  Table[    ImageTransformation[      VStripes[t],    f[#[[1]], #[[2]]] &, DataRange -> {{-Pi, Pi}, {-Pi, Pi}}],  {t, 0, .9, .1}]]

High-res: 800x800

Mathematica code:

f[x_, y_] := {Log[Sqrt[(x)^2 + (y)^2]], ArcTan[x, y]} honeycomb := ImageCrop[  DensityPlot[    Sum[Cos[(Cos[n*2*Pi/6] + Sin[n*2*Pi/6])*x + (Cos[n*2*Pi/6] - Sin[n*2*Pi/6])*y],     {n, 0, 5, 1}], {x, -32 Pi, 32 Pi}, {y, -32.975 Pi, 32.975 Pi},   PlotPoints -> 100, Mesh -> False, Frame -> False,   ColorFunction -> GrayLevel, ImageSize -> 834], 800]honeycombImageTransformation[ honeycomb,f[#[[1]], #[[2]]] &, DataRange -> {{-Pi, Pi}, {-Pi, Pi}}]

High-res: 800x800

Mathematica code:

f[x_, y_] := {Log[Sqrt[(x)^2 + (y)^2]], ArcTan[x, y]} checkergrid :=ImageCrop[  DensityPlot[   Sum[Cos[(Cos[n*2*Pi/4] + Sin[n*2*Pi/4])*x + (Cos[n*2*Pi/4] - Sin[n*2*Pi/4])*y],    {n, 0, 3, 1}], {x, -32 Pi, 32 Pi}, {y, -32 Pi, 32 Pi},   PlotPoints -> 100, Mesh -> False, Frame -> False, ColorFunction -> GrayLevel, ImageSize -> 834], 800]checkergridImageTransformation[ checkergrid,f[#[[1]], #[[2]]] &, DataRange -> {{-Pi, Pi}, {-Pi, Pi}}]