Tag Info

Hot answers tagged

125

I did a very simple (in fact over-simple) snowflake simulator with CellularAutomaton years before. It's based on the hexagonal grid: and range-1 rules: Initial code First we'll need some functions to display our snowflakes: Clear[vertexFunc] vertexFunc = Compile[{{para, _Real, 1}}, Module[{center, ratio}, center = para[[1 ;; 2]]; ratio = ...


81

Here's what I came up with How I did it First we need a list of words. Here, I've taken the original list ordered by size. tally = Tally@ Cases[StringSplit[ExampleData[{"Text", "AliceInWonderland"}], Except@LetterCharacter], _?(StringLength@# > 4 \[And] # =!= "Alice" &)]; tally = Cases[tally, _?(Last@# > 10 &)]; tally = ...


73

How can this code be improved, for example, by including shadows, raytracing or the effects of gravity to make it more realistic? I felt that this question deserved an answer. The one I describe here is to create a set of confetti "agents" that respond in quasi-physical ways to external forces and "know" how they should be displayed. It is handy, and ...


67

A preview Before I show any code, here's a preview of what is possible with some tweaking: First try Here's a go at implementing Wordle's layout algorithm, described at cormullion's link. First, let's generate the word data (this is pretty arbitrary): punctuation = ",/.<>?;':\"()-_!&" (* boring words: *) common = {"the", "of", "and", ...


62

Let's get a low-res image: And put in in gray-scale mode: gimg = ColorConvert[ImageResize[ Import["http://i.stack.imgur.com/wtgxH.jpg"], 300], "Grayscale"]; Now extract the image data (pixel values) together with pixel indexes: data = MapIndexed[Append[#2, #1] &, ImageData[gimg], {2}]; I, of course, couldn't pass on Voronoi styling. We ...


57

A simple algorithm that measures the distance of existing disks from a new, candidate disk, while decreasing radius size. The following two functions generate a random point in the unit disk and measures the distance to all existing disks. randomPoint = Compile[{{r, _Real}}, Module[ {u = RandomReal@{0, 1 - 2 r}, a = RandomReal@{0, 2 Pi}}, ...


55

How to make your eyes hurt Mike asked whether it is possible to recreate the image he posted in his question. Although I haven't searched the web whether the equations for the above image are published somewhere, I will show how you can create such kind of image by pure inspection. By inspecting Mike's original image, one recognizes the following things: ...


52

This approach is based on a random walk of a shrinking disk. Several of these are combined and a Gaussian filter is used to smooth it out. Optionally the smoothed image can be multiplied by the original to restore the tiny "droplets" that are wiped out by the smoothing. There is a streakiness parameter which biases the random walk in a particular direction. ...


46

Yes we can. The following DashedGraphics3D[ ] function is designed to convert ordinary Graphics3D object to the "line-drawing" style raster image. Clear[DashedGraphics3D] DashedGraphics3D::optx = "Invalid options for Graphics3D are omitted: `1`."; Off[OptionValue::nodef]; Options[DashedGraphics3D] = {ViewAngle -> 0.4, ViewPoint ...


45

========== update =========== Remember guys how we can cut out a snowflake from a sheet of paper carving 12th folded part? Like the image below. So I decided to write an app to imitate the process. It also can be used to make random snowflakes (similar to to @bill s' but with reflection to imitate real cutting paper process and reflective symmetry of ...


41

Here's a try: g3 = Graphics3D[{Gray, Sphere[]}, Lighting -> "Neutral", Boxed -> False] img = ColorConvert[Rasterize[g3, "Image", ImageResolution -> 72], "GrayLevel"] edge = ColorNegate@EdgeDetect[img] Manipulate[ dots = Image@ Map[RandomChoice[{#, 1 - #} -> {1, 0}] &, ImageData@ImageAdjust[img, {0, c, g}], {2}]; ...


40

replacing RandomReal function in István's code with u = RandomVariate[UniformDistribution[{0,1 - ((1 - 2 min)/(max - min) (r - min) + 2 min)}]] leads to non-uniform distribution Randomization for the angle can also be non-uniform: randomPoint = Compile[{{r, _Real}}, Module[{u = RandomVariate[ UniformDistribution[{0, ...


36

Let's do it Andy's way So you are Andy. Nice to meet you. And you never got those hands on a keyboard. Doesn't matter, I will show you! First you need to go to Marilyn's place. Don't worry, JF isn't there right now. Ask her for a nice photograph and the negatives. i = ImageCrop@Import@"http://i.stack.imgur.com/W8hV5.png" Outstanding picture, good ...


35

Here's a slow and concave version: blot[smoothness_: 20, points_Integer: 10] := With[ {fun = Exp[-smoothness #.#] &, pts = RandomReal[1, {points, 2}]}, RegionPlot[ Total[fun[# - {x, y}] & /@ pts] > .5, {x, -.5, 1.5}, {y, -.5, 1.5}, Frame -> False, PlotStyle -> Black, BoundaryStyle -> Black] ] Grid@Table[blot[], {3}, {3}] ...


35

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


34

In this answer I've tried to use different shading styles for different graylevels in the image. First load the image, convert to grayscale, and get its dimensions. img = ColorConvert[Import["UZg4t.jpg"], "Grayscale"]; dim = ImageDimensions[img]; The next step is to create different shading styles.The example hedcut image uses dots and lines for shading, ...


33

Let me start from an approach which I believe has its own name, but unfortunately I don't know it. The idea is to generate circles whith radii depending on the intensity of corresponding and surrounding pixels. img = Import["ExampleData/rose.gif"]; bubbled[img_, r_, delta_, rmax_] := Block[{ker, data, radii, thresh = 0.99}, ker = N[#/Total@Total@#] ...


32

A bit of image processing: Table[ Blur[ Dilation[ Graphics[ Table[ Rotate[ Disk[RandomReal[{-10, 10}, {2}], {RandomReal[{1, 5}],RandomReal[{1, 5}]}], RandomReal[{0, 3.14}] ], {40} ] ], DiskMatrix[20] ], 20 ]// Binarize, {3}, {3} ] // Grid Lots of parameters to ...


32

Here's an attempt in which I start with a set of "void points", which will be the centres of the gaps between filaments. The stars are then created as an initially random distribution, and are repeatedly nudged away from their nearest void point. Or, to look at it another way, they are attracted towards the edges of the Voronoi cells defined by the void ...


32

An extended comment follows. Mondrian, in the late work referenced by the OP and characterized by primary colored rectangles separated by black lines, employes an extraordinarily sophisticated understanding of perception, color, and light. As background to understand what Mondrian does, I recommend The Interaction on Color, by Joseph Albers and Alfred C. ...


31

No fluid dynamics I'm afraid, but here's what I came up with Preliminaries n = {200, 200, 200}; dim = 2; edges = {.015, .018, .024}; speed = {{0, -1}, {0, -1.5}, {0., -2}}; basePoly = {{0, -1}, {1/2, 0}, {0, 1}, {-1/2, 0}}; period = 3; Initial position colour and orientation angularVelocity = N[RandomChoice[Range[-8, 8], #] period Pi] & /@ n; ...


31

Take an image: Grayscale, flip, and smooth it: j = CurvatureFlowFilter[ImageReflect[ColorConvert[i, "Grayscale"]]] Then let ListContourPlot do all the work! lcp = ListContourPlot[ImageData[j], Frame -> False, Contours -> Table[p, {p, 0, 1, 0.025}], ColorFunction -> "GrayTones", ContourStyle -> None, PlotRange -> {0, 1}] Make it ...


29

An inkblot used to look like this, in the days when I used fountain pens and indian ink, rather than Mathematica: blot = Image[BubbleChart[RandomReal[1, {20, 3}] , Axes -> None, Frame -> None, ColorFunction -> Function[Black], BubbleSizes -> {.001, .3}, Background -> LightGray, ChartElementFunction -> "NoiseBubble", ImageSize ...


29

This shows a way to parametrise a line using the method suggested by Rahul Narain in a comment, i.e. using Fourier to approximate the data with a set of sinusoids. I use Rationalize to convert all the reals back to rationals, this isn't necessary but it makes the expression look more like those used in Wolfram Alpha. param[x_, m_, t_] := Module[{f, n = ...


28

Now that two of our resident Mathematica geniuses (genii?) have produced such awesome examples, there's not much room left for anyone else... :) But that didn't stop me - and I'm here to make you guys look good. I had an idea... I decided not to make a cloud, but a tale - or rather, a tail. I've pinched Szabolc's code to get the words and frequencies: ...


28

This vectorisation attempts to represent the image with coloured triangles. The code selects a user defined number of sample points, with the selection weighted according to the image gradient, to obtain finer sampling in more detailed regions of the image. I use ListPlot3D to triangulate the sample points into a set of polygons - there is probably a neater ...


28

This methods relies on generating random circles and then removing circles that overlap with circles that were found earlier. I suppose one should really divide the surface into bins and only check for overlaps between subsets of the circles. Especially if there is an upper bound to the size of a circle (the bound in my code is 1, which is not practical). ...


27

Here's another shape-packing one, with a binary image used to define the shape to be filled. I use a DistanceTransform on the image, which provides a convenient way to measure the distance from any point to the boundary of the shape. I've used Istvan's distance function, but instead of choosing a spot size and then locating somewhere to put it, I choose a ...


26

Here is my modest attempt at confetti: With[{g = 9, n = 120}, confe[t_] = Table[ With[{f = RandomReal[{9, 20}], th = RandomReal[{Pi/4 + Pi/12, Pi/2 - Pi/12}], ph = RandomReal[{-Pi, Pi}]}, Translate[ With[{l = RandomReal[{2/5, 3/4}], h = RandomReal[{2/5, 3/4}], c = RandomReal[{0, 1}]}, ...


26

Edit Here is a different approach using Graphics to actually draw some brush strokes. I run a GradientOrientationFilter on a smaller version of the image to estimate the local image gradient, and use that information to create a collection of randomly shaded lines: img = Import["http://i.stack.imgur.com/XwYg7.jpg"]; im = img ~ImageResize~ 200 ...



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