Hot answers tagged

381

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


371

The code below attempts to apply the XKCD style to a variety of plots and charts. The idea is to first apply cartoon-like styles to the graphics objects (thick lines, silly font etc), and then to apply a distortion using image processing. The final function is xkcdConvert which is simply applied to a standard plot or chart. The font style and size are set ...


310

Mostly thanks to Belisarius's elegant wrapping, you can do h[fun_, divisor_, color_, at_] := Module[{k}, k = BSplineFunction[Table[fun@x + RandomReal[{-0.1, 0.1}/divisor], {x, 0.01, 10, .1}]]; ParametricPlot[k[x], {x,0.1,0.9}, PlotStyle->{color, AbsoluteThickness@at}, Axes-> None]]; Show[{ h[{#, 1.5 + 10 (Sin[#]^2/Sqrt[#]) Exp[-(# - 5)^2/2]} &...


201

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


149

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


108

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


107

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


89

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


88

Time to join in the fun. version 2 Result Method I produce the basic plot with ticks and labels: Plot[{x/2, (x + Sin[x])/2.2}, {x, 0, 2 Pi}, MaxRecursion -> 0, PlotPoints -> 30, Axes -> False, Frame -> {True, True, False, False}, FrameTicks -> {{{0.2, "Start", 0.07}, {3, "lunch", 0.05}, {6, "Finish", 0.06}}, None}, PlotLabel -> ...


83

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


77

I'm very late to the party, but here's a convenient xkcd guy generator: This was generated as: With[{ h = xkcdGuy[-10, "hat", 0.2, {20, -90}, {-57, -10}, {-20, 0}, {20, 0}], n = xkcdGuy[0, "none", -0.2, {-10, 0}, {50, 10}, {-20, 0}, {20, 0}]}, Graphics[{First@n, Rotate[Translate[First@h, {3.3, 0}], 10 Degree]}] ] // xkcdConvert using Simon'...


76

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


76

Here's a quick take on it: Clear[spiralize]; spiralize[p_, d_:10, r_:4, f_:0.8, s_:1, t_:0.005]:=Module[{m,rr=r}, m = Mean @ p[[1]]; Graphics[{EdgeForm[Thickness[t]],FaceForm[White], NestList[GeometricTransformation[ GeometricTransformation[#, RotationTransform[rr++s \[Degree],m]], ScalingTransform[{f,f},m] ]&...


75

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


75

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


71

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


71

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}}, {Sqrt@u*Cos[...


70

To implement datenwolf's suggestion to perturb curves with Perlin noise to give that "hand-drawn" look and feel, here's one way to use one-dimensional Perlin noise for the perturbation: fBm = With[{permutations = Apply[Join, ConstantArray[RandomSample[Range[0, 255]], 2]]}, Compile[{{x, _Real}}, Module[{xf = Floor[x], xi, xa, u, i, j}, xi = Mod[...


65

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


64

My original code was crashing when you used too many digits because apparently Mathematica can handle only so many different font sizes. To fix it, I had to borrow george2079's PDF trick to turn each character into a vectorised graphics primitive. I couldn't have solved this issue myself, so give his answer an upvote please. The rest of the code is still my ...


64

Here is a start. I'm sure others will come up with better solutions, but I think from here it's mostly down to finding a better algorithm to pick the random lines. First, we get ourselves a Region representation of the text we want to stylise (thanks to yode for simplifying this part): textRegion = DiscretizeGraphics[ Text[Style["MUSEUM", FontFamily ->...


63

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


54

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


54

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


53

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


53

Edit: Added the reversal and some refinements ω = 1; posP[t_, φ_] := Sin[ω t + φ] {Cos[φ], Sin[φ]} posL[φ_] := {-#, #} &@{Cos[φ], Sin[φ]} Animate[ Graphics[{PointSize[0.02], Table[{Black, Line[posL[π i]], Hue[i], Point[posP[t, π i]]}, {i, 0, 1, 1/(3π-Abs[9.43-t])}] }, PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}} ], {t, 0, 6π, 0.2} ]


48

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


48

I'd like to expand on Quantum_Oli's answer to give an intuitive explanation for what's happening, because there's a neat geometric interpretation. At one point in the animation it looks like there is a circle of colored dots moving about the center, this is a special case of so called hypocycloids known as Cardano circles. A hypocyloid is a curve generated ...


45

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


42

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



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