# Creating a foggy image

I want to create foggy images like this one (produced with Adobe Photoshop):

Not at least familiar with Mathematica's Image processing capabilities, the only thing I am able to do is something like this:

Graphics3D[{{Orange, Sphere[{40, 45, 45}, 40]}, Opacity@0.05,
Raster3D[Table[{1 - x, z}, {x, .1, 1, .01}, {y, .1, 1, .01}, {z, .1, 1, .01}]]},
Axes -> False,
Boxed -> False,
ViewPoint -> {1000, 0, 0}]


What I really want to find is a blurry, fuzzy Lena, hopefully not confined to black & white.

Any ideas?

• fog is a nasty thing because it not only blurs, but also reflects light. And both effects are spatially inhomogeneous – Dr. belisarius Sep 22 '14 at 19:56
• ImageAdjust[Blend[{image, Blur[image, 50]}, 0.8], -0.4] – user484 Sep 22 '14 at 20:22
• @RahulNarain I'm somehow perplexed that your nice comment is only a comment. – eldo Sep 22 '14 at 20:29
• @RahulNarain, I think yours looks much better. Please consider posting it as an answer. – RunnyKine Sep 22 '14 at 21:29
• I think the exact analogue to what you did in Photoshop is actually an example in the documentation for SetAlphaChannel. You can get a more 3D effect by using Raster3D, but that would probably be overkill. – Jens Sep 22 '14 at 22:49

Here is my attempt to imagine Lena in a fog

img = ExampleData[{"TestImage", "Lena"}];
r = 200;
r0 = 2;
ker = Table[1/(i^2 + j^2 + r0^2), {i, 0. - r, r}, {j, 0. - r, r}];
ker = ker/Total[ker, 2];
foggy = ImageConvolve[img, ker]


I think Lorentzian kernel is quite good for the fog: it has a sharp peak and broad tails

Plot3D[1/(i^2 + j^2 + r0^2), {i, -10 r0, 10 r0}, {j, -10 r0, 10 r0},
PlotRange -> {0, All}, PlotPoints -> 100]


With the ambient lighting (thanks to Simon Woods!):

ImageApply[0.7 # + 0.3 &, foggy]


• Very nice. Maybe add a bit of white for scattering of ambient light? ImageApply[0.7 # + 0.3 &, foggy] – Simon Woods Sep 22 '14 at 20:51
• thanks @ ybeltukov - I hoped you would step in. – eldo Sep 22 '14 at 20:54
• Lorentzian instead of Loretzian right? – Öskå Sep 23 '14 at 0:23
• @Öskå Corrected, thanks! My spellchecker doesn't know such a kernel :) – ybeltukov Sep 23 '14 at 1:05
• +1 for using Lorentz kernels. I love Lorentz kernels for blurring! They are more computationally intensive than Gaussian blurs because the Lorentz kernel is not separable, but the heavy-tailed properties give a much nicer image in certain circumstances, and this is no exception. – DumpsterDoofus Sep 23 '14 at 1:47

Does this work for you? (otherwise I'll delete it and let the imaging experts handle this)

img = ExampleData[{"TestImage", "Lena"}];


Then:

res = ImageConvolve[img, BoxMatrix[8]/289.];

ImageAssemble[{img, res}]


• +1 Your answer must stay. First time I encountered BoxMatrix. Lena has become blurry und fuzzy. Is she foggy? Maybe a certain amount of randomness should be injected? – eldo Sep 22 '14 at 20:07
• @eldo Thanks. So many functions in Mathematica, it's impossible to know them all. Nice idea about the randomness. – RunnyKine Sep 22 '14 at 20:09

The core of the logic is in this line:

ImageAdjust@InverseRadon[Radon[img, {n, n}, Method -> method],
"Filter" -> inverseMethod, "CutoffFrequency" -> cutOffFrequency]


By controlling the cutoff frequency, methods used, and applying your own custom backprojection method, you can achieve many different foggy effects.

code:

Manipulate[
"Filter" -> inverseMethod, "CutoffFrequency" -> cutOffFrequency]
,
Grid[{
{Control[{{cutOffFrequency, 1, Text@Row[{Subscript[Style["f", Italic, 11],
Style["c", Italic, 11]]}]}, .01, 1, 0.01,
ImageSize -> Small, Appearance -> "Labeled"}]
},
ControlType -> PopupMenu, ImageSize -> All}]},
{
Control[{
{inverseMethod, # Cos[# Pi] &, "Inverse Radon method"},
{(1 + Cos[# Pi])/2 & -> "Hann",
1 & -> "Rectangular",
# & -> "Ramp-Lak",
# Sin[# 2 Pi] & -> "Sin Ramp",
# Cos[# Pi] & -> "Cosine Ramp",
((1 - 0.16)/2 - (1/2) Cos[# Pi] + 0.08 Cos[# 2 Pi]) & -> "Blackman",
(0.355768 - 0.487396 Cos[# Pi] + 0.144232 Cos[# 2 Pi]) -
0.012604 Cos[# 3 Pi] & -> "Nuttal window",
Sinc[#] & -> "Shepp-Logan",
(.54 + .46 Cos[# Pi]) & -> "Hamming",
Sqrt[1/(1 + #^(2))] & -> "Butterworth order 1",
Sqrt[1/(1 + #^(4))] & -> "Butterworth order 2",
Sqrt[1/(1 + #^(6))] & -> "Butterworth order 3",
None -> "No filter"},
ControlType -> PopupMenu, ImageSize -> All}]
}}],
ContinuousAction -> False,
Initialization :>
(
n = 200;(*image size to display, smaller is faster*)
img = ExampleData[{"TestImage", "Lena"}];
)
]

• Thanks @ Nasser :) Certainly much more than I asked for. Also, some images produced wizh your method are so beautyful. – eldo Sep 22 '14 at 23:13
• Excellent use of Radon transform! +1 – dr.blochwave Sep 23 '14 at 8:01