15
$\begingroup$

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

the image with the lines marked

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

how the matrix looks

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.

final result

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.

Improve this question
$\endgroup$
3
  • $\begingroup$ Have you seen this?: mathematica.stackexchange.com/a/5695/121 $\endgroup$ Commented Apr 19, 2013 at 11:27
  • $\begingroup$ I'm not sure which part of that problem is relevant since it seems a lot more advanced. I did get the idea of using FindGeometricTransform from another answer, but I don't seem to have understood it properly: mathematica.stackexchange.com/questions/1524/… $\endgroup$ Commented Apr 19, 2013 at 11:33
  • 1
    $\begingroup$ I'm not sure either, it's just the first thing that came to mind. $\endgroup$ Commented Apr 19, 2013 at 12:13

3 Answers 3

Reset to default
16
$\begingroup$

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)

enter image description here

and here is the rotated image:

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ +1. slope could be made shorter: slope[s_, e_] := ArcTan @@ (e - s) $\endgroup$ Commented Apr 19, 2013 at 13:12
12
$\begingroup$

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]

weighted histogram plot

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

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ It works perfect ! Thanks but FindMaximum takes long time to evaluate... Do you have any other solution? $\endgroup$ Commented May 16, 2014 at 14:08
8
$\begingroup$

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]

enter image description here

Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.