Rotate a grid, made up of lines, so that it aligns with the xy axes

Question

While working on an answer for another problem I hit upon one of my own.

I took the image given in that question and cleaned it up so that I could detect the grid lines:

i = ColorNegate@
  Binarize[Import["https://i.sstatic.net/NbTGY.jpg"], .99]

lines = ImageLines[
   Image[ImageData@Dilation[i, 0.5] - 
   ImageData@DeleteBorderComponents@Dilation[i, 0.5]]
];

Show[i, Graphics[{Thick, Green, Line /@ lines}]]

From here I would like to rotate the grid so that the they are absolutely vertical and horizontal. The original picture looks like a scanned piece of paper and I imagine it could be rotated more than this sample is.

My attempt was to separate the horizontal lines from the vertical lines:

hor = Select[lines, #[[1, 1]] == 0 &];
ver = Reverse[Select[lines, #[[2, 2]] == 0 &], 2];

Then I would like to find a transfer function that will bring the end point of each horizontal line to the same y value that the starting point has, and respectively for the vertical lines.

So my fruitless attempt to do that looks like this:

pts = {Join[Transpose[Apply[{#, 0} &, ver, {2}]][[1]], 
   Transpose[Apply[{0, #2} &, hor, {2}]][[1]]], 
  Join[Transpose[Apply[{#, 0} &, ver, {2}]][[2]], 
   Transpose[Apply[{0, #2} &, hor, {2}]][[2]]]}
pts // MatrixForm

And then

transf = FindGeometricTransform[pts[[1]], pts[[2]]][[2]];
newLines = transf@# & /@ lines;
Show[ImagePerspectiveTransformation[i, transf, DataRange -> Full], 
 Graphics[{Thick, Green, Line /@ newLines, Yellow, Line /@ lines}]]

It returns errors and I don't get the rotation I'm looking for.

Any ideas are welcome as long as they start from the lines that I have. It may be possible to find the grid in a different way and perhaps then the procedure to find the rotation would not be the same.

Answer 1

Here's a simple method that seems to work. Call the grid above img. Find the best/strongest line in the image:

lines = ImageLines[img, MaxFeatures -> 1]

We'll need the slope of this line - here's a function to do that

slope[s_, e_] := ArcTan@@(e - s);

(shorter version thanks to nikie). This can be applied as

slopeLine = First[slope @@@ lines]

For this image, we get a slope of -0.00943421. So now rotate the image back through this value:

ImageRotate[img, -slopeLine]

which straightens it up reasonably well. Here's the strongest line in the image (the orange one)

and here is the rotated image:

Answer 2

If you have v9, here's an alternative solution: first I calculate the gradient and gradient orientation for each pixel

gray = ColorConvert[img, "Grayscale"];
orientation = GradientOrientationFilter[gray, 3];
gradient = GradientFilter[gray, 3];

then I create a weighted histogram from those:

wd = WeightedData[Flatten[ImageData[orientation]], 
   Flatten[ImageData[gradient]]];
hd = SmoothKernelDistribution[wd];
Plot[Evaluate[PDF[hd, x]], {x, -\[Pi]/2, \[Pi]/2}, Filling -> 0]

since the kernel histogram is a smooth function, I can use FindMaximum to find the orientation with the largest total weight:

max = FindMaximum[Evaluate[PDF[hd, x]], {x, 0}]

=> {0.712209, {x -> -0.0118227}}

And then rotate the image around that angle:

ImageRotate[img, -x /. max[[2]]]

Answer 3

As an addition to @bills's answer you can rotate by the mean of the slope of all the detected lines.

slopeLine = slope @@@ lines
meanslope = 
 Mean@Join[Select[slopeLine, # > -1 &], 
   Select[slopeLine, # < -1 &] + Pi/2]
ImageRotate[img, -meanslope]