Tag Info

Hot answers tagged

345

I have to confess that I see this as a proper challenge, as I am usually quite creative in finding/combining functions to provide a desired behavior. So I will give it another try. which is generated using box[x_, x1_, x2_, a_, b_] := Tanh[a (x - x1)] + Tanh[-b (x - x2)]; ex[z_, z0_, s_] := Exp[-(z - z0)^2/s] and r[z_, x_] := (*body*).4 (1.0 - .4 ...


189

This might get me suspended from the site butt I cannot resist. The shape you are looking for can probably be approximated (depending how anal you want to be about the outcome) by two assymetric probability distributions. The obvious choices would be a Poasson or a log normal distribution. I will use the latter as it is continuous. Now the bummer is that ...


140

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


101

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


93

Parametric Buttocks Manipulator Manipulate[ ParametricPlot3D[{ (e u^p + (1 + (c - a u) (u - 1)) Cos[t]^2) Sin[t], (e u^p + (1 + (d - b u) (u - 1)) Cos[t]^2) Cos[t], 2 u}, {t, -0.2, Pi + 0.2}, {u, 0, 1.1}, Lighting -> "Neutral", Mesh -> None, PlotStyle -> Directive[Specularity[0], RGBColor[0.92, 0.85, 0.73]], Axes -> False], {{a, ...


82

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


77

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


67

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


67

Amusingly enough, the images above actually arose as an accidental by-product of browsing inane YouTube conspiracy theory videos. I happened across a rather beautiful video of a "mirror cube" device produced by a man in Germany named Ben Palmer, who apparently produced it in an attempt to bring recognition to a philosopher named Walter Russell (the first ...


64

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


63

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


63

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


56

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


51

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


50

Let's do it Andy's way So you are Andy. Nice to meet you. And you never got those hands on a computer. It 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 ...


49

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


42

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


41

First of all let me tell you that you should wait for some great submissions from other members. Maybe @Yu-SungChang will post some FPS game here ;-). I just will give you the prototype I happen to write recently for an unrelated task. I could fly around your example too but it is too slow (and cool ;-) ) - I will demo some more fluid but simple environment. ...


39

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


39

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


39

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


38

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


36

First, define the dimensions and colors associated with our matrix: {mheight, mwidth} = mdim = {12, 20}; mdepth = 20; mcolors = Reverse@Array[ Blend[{{0, Darker[Green, 0.9]}, {0.4, Darker[Green]}, {0.6, Darker[Green]}, {0.90, Lighter[Green]}, {1, Lighter[Green, 0.8]}}, #/(mdepth - 1)] &, mdepth, 0]; Next, define some useful ...


35

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


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

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


34

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


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@#] ...


33

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


33

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



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