Wer erinnert sich noch an die Kästen "Malen nach Zahlen" aus seiner Kindheit? Beim Herumspielen mit Mathematica folgendes, wenn nicht schönes, so doch lustiges Ergebnis erzielt. Sucht jemand vielleicht noch nach einem Weihnachtsgeschenk?

Für alle Techniker hier der überraschend simple Code. Hat man eine farbige Vorlage, so kann man aus den Rasterinformationen (mittels Map[ #[[i]]&, g[[1,1]],{2}] (* i=1,2,3 *) auch die einzelnen Farbkanäle herausfiltern. Habe bei meinem Bild festgestellt, dass der Rotauszug den besten, rundesten Eindruck hinterlässt. Was daran liegen mag, dass Gesichtsfarbe eine weite Spanne an Rottönen enthält.

g = Import["filename.ext"];
b = Map[ First[#] &, g[[1, 1]], {2}];


ListContourPlot[b,
    Contours -> 6,
    ContourLines -> True,
    ContourShading -> False,
    ContourSmoothing -> Automatic,
    AspectRatio -> N[Apply[Divide, Dimensions[b]]],
    Frame -> False
    ];

Besonders stolz bin ich als eingefleischter Emacs-Fan über die Anwendung funktionaler Programmierung!