Tag Info

Hot answers tagged

46

The idea behind this solution is to construct a superposition of Gaussian surfaces whose amplitude decay in time, and use DensityPlot to plot the trail: trail[fun_, {t_, tmin_, tmax_, dt_}, k_, lam_][xxx_, yyy_] := Module[{trange, xrange, yrange, twindow, trailf, sel, decayf}, decayf[x0_, y0_, t0_] := Exp[-k t0 - lam^2 (x0^2 + y0^2)]; twindow = 6/k; ...


37

Here is a simple approach to create a ghost trail: obj[{xfunc_, yfunc_}, rad_, lag_, npts_][x_] := MapThread[ {Opacity[#1, ColorData["SunsetColors", #1]], Disk[{xfunc@#2, yfunc@#2}, rad Exp[#1 - 1]]} &, Through[{Rescale, Identity}[Range[x - lag, x, lag/npts]]]] frames = Most@Table[Graphics[obj[{Sin[2 #] &, Sin[3 #] &}, 0.1, 1, 500][u], ...


34

My simple version using Image: size = 300; r = ListConvolve[DiskMatrix[#], RandomInteger[BernoulliDistribution[0.001], {5 size, size}], {1, 1}] & /@ {1.5, 2, 3}; Dynamic[Image[(r[[#]] = RotateRight[r[[#]], #]) & /@ {1, 2, 3}; Total[r[[All, ;; size]]]]] Update A slightly prettier version, same basic idea but now with flakes. flake := ...


33

Let me join. logo = Cases[ p7 /. triangulate /. moretriangles /. shrink /. shrink /. shrink /. colour3[] /. colour4["SunsetColors", 1, 28/34] , {c__, Polygon[pts__]}, \[Infinity]]; logo = SortBy[logo, First]; p = Evaluate[InterpolatingPolynomial[{ {0, {0, 0, 0, 0}}, {Pi, {Pi, 0, 0, 0, 0}}, {2 Pi, {2 Pi, 0, 0, 0}}},#]] &; pp[a_] := If[Abs[a - ...


31

Breathing with occluded borders, per Toad's request: Run the following command to get the Mathematica code NotebookPut@ImportString[Uncompress@FromCharacterCode@Flatten@ImageData[ Import@ "http://i.stack.imgur.com/VqjJ9.png","Byte"],"NB"]


30

Who wanted the automagic? :) mmastar[as_, nn_: 1] := Graphics[ Scale[#, 1/max@#, {0, 0}] &[ Polygon[pt /@ as] /. triangulate /. moretriangles /. shrink /. shrink /. shrink /. colour3[] /. colour4[] /. curve /. bolicsn[nn]], AspectRatio -> Automatic, PlotRange -> 0.025]; da = 0.0001; max[zu_] := Cases[zu, {_?NumericQ, ...


29

As per the blog: Export["breathing.gif", Table[Graphics[ p7 /. triangulate /. moretriangles /. shrink /. shrink /. shrink /. colour3[] /. colour4["SunsetColors", 1, 28/34] /. curve /. bolicsn[(1 - Cos[2 \[Pi] t])/2], ImageSize -> 150], {t, 0, 1, 0.05}]]; Some good old fashioned colour cycling: Clear[f]; f[c_] /; c > 2 := c - 2; f[c_] ...


27

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


26

The first step is to rasterize the points, so let's just start there as an example: n = 512; g = Image[Map[Boole[# > 0.001] &, RandomReal[{0, 1}, {n, n}], {2}]] The trick is to exploit the distance image. Almost all the work is done here (and it's fast): i = DistanceTransform[g] // ImageAdjust // ImageData; We need a little more precomputation ...


26

Here you have a toy to start playing with: Edit preventing the animation running at different speeds in different machines by using Clock[] and DynamicWrapper[] (due credit to @jVincent) n = 500; (*number of managed particles*) x[i_][t_] := (vx0[i] (t - delay[i])) UnitStep[t - delay[i]]; y[i_][t_] := Module[{k}, If[(k = (-#^2 + vy0@i #) UnitStep@#) < ...


25

Load some images: size = {200, 200}; foot = ImageResize[Import[ "http://upload.wikimedia.org/wikipedia/commons/a/ab/Monty_python_foot.png" ], size]; spikey = ImageResize[Import[ "http://upload.wikimedia.org/wikipedia/en/b/bf/MathematicaSpikeyVersion8.png" ], size]; mse = ImageResize[Import[ "http://i.stack.imgur.com/yjrEY.png" ], size]; ...


25

Note that ViewPoint is given in specially scaled coordinates which depend on amongst things the size of the bounding box. To get better control over the positioning of the camera you could use ViewVector instead, which is given in terms of the coordinates of the plot. You could for example do something like this: rotateMeHarder1[g_, vertical_, viewpoint0_, ...


25

Read comments to your post - many good links there. Additionally, are a few thoughts on the topic. 1) Avoid PPT, - use built-in Mathematica slideshow templates, they were recently updated and are beautiful. Advantage is - you preserve computations and native graphics (like rotations in 3D, etc.). You can read more in this post: Best way to give ...


24

The following is a little involved, but it calculates the "minimum displacement" evolution by choosing the least total displacement alternatives from the permutations generated by the "AutomorphismGroup" of the graph: {n, edges, coords1, perms} = GraphData["PappusGraph", {"VertexCount", "EdgeList", ...


23

Embedded cdf with music version. code at the bottom For full period, change max t to 200, my gif is cut in half because for some reasons I couldn't upload whole. f[r_, t_] := Mod[-t (1 - r), 2. Pi]; dr = Pi /100. Animate[Graphics[{ Table[{ AbsolutePointSize[10 # + 2 + 2 Unitize@Clip[f[#, t] - 5.5, {0, 1}]], ...


22

Here is an example of how to create an animation from DensitPlot results. I have chosen a simple Gaussian function to plot, but its center depends on a parameter t. Now I create a table of plots for many different values of t, and then I take several different steps to create various kinds of movies from it. The parameter t and its step size is going to be ...


22

Try a simple way. Typical key frame animation is done by nothing more than n-degree interpolation (and n is usually 1), and they look quite reasonable. Here is how I would tackle (it is generic version, so individual points have its own colors). Define "start" and "final" positions: startPos = RandomReal[{-2, 2}, {4000, 2}]; normalRDN[μ_, σ_, No_] := ...


21

With a bit of blur, but still not the variable-width blur in the example. obj[{xfunc_, yfunc_}, rad_, lag_, npts_][x_] := With[{trail = Range[x - lag, x, lag/npts]}, {ColorData["SunsetColors"]@#1, Opacity@#1, Disk[{xfunc@#2, yfunc@#2}, rad]} & @@@ Transpose[{Rescale[trail], trail}]] frames = Most@ Table[ImageCompose[# ~Blur~ 4, ...


21

Here's my contribution. I know you asked for hints only, but I couldn't resist text = Style["This is some text on a Möbius strip", FontFamily -> "Helvetica", FontSize -> 35]; img = ImageData@Image[Rasterize[text, Background -> None, ImageSize -> 1000]]; Manipulate[ ParametricPlot3D[{4 Cos[a] + r Cos[a] Cos[a/2], 4 Sin[a] + r Sin[a] ...


21

A very rough interpretation, which I hope might at least give some ideas: (* Final image *) fin = (p7 /. triangulate /. moretriangles /. shrink /. shrink /. shrink /. colour3[] /. colour4["SunsetColors", 1, 28/34]); icycle[ j_, k_] := Table[Graphics[fin[[1 ;; i, j, k]], PlotRange -> 1], {i, 7}] kcycle[i_, j_] := ...


21

I happened to create some snowflakes and snow fall a couple weeks back, and its nice to have some place to share with others! First, we create some algorithmically generated snowflakes with some randomness using a kind of iterated function system based off the 6-pointed "star" shown below. H = Table[{Cos[n*Pi/3], Sin[n*Pi/3]}, {n, 0, 5, 1}]; ...


19

Yes, you can create a table of the plots at appropriate time intervals and then use ListAnimate[] on the table.


19

Here's a spinning "3D version" of the logo Using the code from meta/blog to create the logo (assigned to the variable logo), continue with the following steps: side[o_] := Block[{z, pts = Partition[ Table[N[{Cos[t], Sin[t], z}], {t, Pi/14, 2 Pi, 2 Pi/7}], 2, 1, 1]}, Composition[Polygon, Flatten[#, 1] &] /@ Thread[{pts /. z -> o/2, Reverse ...


19

Here's a starting point: tex = Rasterize[ Style["Going round and round and round the Möbius strip! ", Bold, Large, FontFamily -> "Times"]] {w, h} = ImageDimensions[tex] tex1 = ImageTake[tex, All, Quotient[w, 2]] tex2 = ImageTake[tex, All, Quotient[w, 2] - w] frames = Table[ Rasterize@ ParametricPlot3D[{Cos[u], Sin[u], 0} + r ...


18

I don't know if you can persuade Import to return the correct durations, but luckily the format of .gif files is pretty straight forward so it's not that hard to extract the correct durations manually from the raw data. In an animated gif the frame durations are stored in a so called Graphic Control Extension or GCE preceding each frame. A GCE starts with ...


18

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


17

Then add some salt q = 20; pos = Table[.1 i, {i, q}]; {start, end} = RandomReal[1, {2, q}]; pts[i_Integer, t_Real] := {pos[[i]], (1 - t) start[[i]] + t end[[i]]} c[t_Real] := Interpolation[Table[pts[i, t], {i, q}], Method -> "Spline"]; Manipulate[ Plot[c[t][x], {x, 0.1, 2}, PlotRange -> {{0, 2.1}, {-.5, 1.2}}, Epilog -> { Red, ...


16

I tried something similar last week but with the 24-cell. Perhaps it can be modified for the tesseract. Create a stereographic projection function from the 3-sphere (in $\mathbb{R}^4$) to $\mathbb{R}^3$. Proj[{x1_, x2_, x3_, x4_}] := {x1, x2, x3}/(1 - x4); Create a list of the 24 vertices. I got the coordinates from the wikipedia page for the 24-cell. ...


16

This is my approach, has nothing to do with projection, and it is a little complicated. I get all coordinates and faces first to determine both start and end state. Then, change the start state smoothly to the end. coor = Flatten[PolyhedronData["Cuboid", "VertexCoordinates"], 1]; face = Flatten[PolyhedronData["Cuboid", "FaceIndices"], 1]; edge = ...


15

I know think of at least one way of doing it slowly and in a bitmap approach: img[p_, r_] := Module[{f, closest, color, colors, n, t}, n = 250; colors = List @@@ {Red, Green, Blue, Yellow, Orange, Pink, RGBColor[0, 0, 0], Cyan, Magenta, Brown, Purple}; color[i_] := Module[{c}, c = colors[[1 + Mod[i, Length@colors]]]; If[i == 0, {1, ...



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