Cleaning mildew from old documents using Mathematica (Image processing)

Question

While visiting family over the holiday period, I managed to have some good mother-daughter bonding over how far back I’ve managed to trace the family tree (Mom is in her 80s and doesn’t do computers). I’ve been using the usual databases like Ancestry.com, familysearch.org and asking the odd question over on genealogy.SE when I get stuck. But I’ve also been lucky that certain old church records for parts of Kent in England have been scanned and the images available online.

Unfortunately some of them are in poor condition, and I thought I could use Mathematica’s image processing capabilities to clean them up a bit. Take this example:

raw = ImageRotate[Import["http://goo.gl/er4c5"], 180 Degree];

Cleaning this up with Sharpen and some of the filters like MeanShiftFilter definitely helps.

sharpened = Sharpen[raw, 3]    
s2 = MeanShiftFilter[sharpened, 2, 0.03, MaxIterations -> 20]

But there are still a lot of mildew blotches on the image. I’d like to fade out the things that look like disks, and darken the things that look like handwriting, but I have not yet found the iteration of things like MorphologicalComponents that would do the trick. I keep getting the background of the page as the connected component, so I can’t, for example used the "Holes" property to select handwriting and not mildew blotches.

Does anyone have any suggestions? I’m quite unfamiliar with the image processing side of Mathematica.

Answer 1

Here are a couple of ideas, but nothing spectacular (although the full size images look a bit better than the 600 x 480 pixel ones in this post).

BottomHatTransform can be used to find small dark objects:

BottomHatTransform[raw, DiskMatrix[5]] // ColorNegate

Another possibility is to use RidgeFilter to try to pick out the writing (I reduced the image size for RidgeFilter as it was a bit slow on the full size image)

((raw // ColorNegate)~ImageResize~Scaled[0.5]~RidgeFilter~1~
ImageResize~Scaled[2] // ColorNegate)~ImageAdjust~{0, 0, 2}~Sharpen~10

Answer 2

Here is a first attempt based on nikie’s answer over on DSP.SE, as mentioned by cormullion in comments.

The first point to notice is that, as well as cropping out the black borders and labels, I’ve used the ImageAdjust command to increase the contrast. This makes the Closing process a bit cleaner as we’ll see later on.

raw = ImageCrop[
ImageCrop[
ImageRotate[Import["http://cityark.medway.gov.uk/Scans/Ecclesiastical_Rochester_\
 Archdeaconry_Area_Parishes/P167_HIGH_HALSTOW_1653_1957/01_Incumbent_\
 Service_Registers_1653_1957/P167_01_01.html/00000040.jpg"],180 Degree], {Full, 2820}, Top]];
sharpened = ImageAdjust[raw, 0.4];

It takes a bit of trial and error to work out the right size for the closing, but in cases where there are clear mildew spots like this one, the DiskMatrix is the way to go.

cl1 = Closing[sharpened, DiskMatrix[6]]

Nikie’s method involved division of the ImageData, which fails badly if there is an absolute black spot that one is trying to remove - it implies dividing by zero. With a bit of fiddling, I came up with this alternative, using only image processing functions rather than going to raw ImageData and back. Notice again that I've increased the contrast. It’s a lot more legible at full size.

result1 = ImageAdjust[
 ColorNegate[ImageSubtract[ColorNegate[sharpened], ColorNegate[cl1]]], .6]

Next I’m going to try an even more difficult case in full colour, one where there is significant damage to the original parchment. (It’s particularly interesting to me because the second entry on the page records the baptism of Daniel Crump or Cromp, my 6-x-great-grandfather.)

rawc = ImageCrop[ Import["http://cityark.medway.gov.uk/query/results/Scans/Ecclesiastical_Rochester_Archdeaconry_Area_Parishes/P362_SWANSCOMBE_1559_1978/01_Incumbent_Service_Register_1559_1978/P362_01_01.html/0055.jpg"] , {2000, 3400}, {Right,Bottom}];

The first thing to notice is that just using ImageAdjust to increase the contrast and shift the gamma can make things a lot easier.

sharperc = ImageAdjust[rawc, {0.6, 0, 0.9}]

Nikie’s method for screening out the varying background colours would look something like this. Notice that I reduced the contrast and brightness slightly to avoid divide by zero problems.

whitec = ImageAdjust[Closing[sharperc, 5], {-.1, -0.1}]

Which produces something like:

The resulting text is quite faint but more legible than before. Adding contrast doesn’t help here because quill pen ink varies in color even within a letter or word, so you can’t find a threshold for Binarize that doesn’t also bring in some of the residue background. Notice that I’ve used nikie’s method directly this time, but with a slight fudge factor in the denominator to avoid divide-by-zero errors.

whiteAdjustedc = 
 Image[ImageData[sharperc]/(ImageData[whitec] + 0.001)]

Remaining work to do would include finding a way to darken the tails of letters so they don’t disappear when increasing contrast in the image, and smoothing the Closing background a bit more, which would remove some additional noise in the final image. I experimented with a final Closing[#,2] to eliminate noise, but that removed too much of the ends of letters. There might be a filter that does that.