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.stack.imgur.com/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.

  • $\begingroup$ Have you seen this?: mathematica.stackexchange.com/a/5695/121 $\endgroup$
    – Mr.Wizard
    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$
    – C. E.
    Apr 19, 2013 at 11:33
  • 1
    $\begingroup$ I'm not sure either, it's just the first thing that came to mind. $\endgroup$
    – Mr.Wizard
    Apr 19, 2013 at 12:13

3 Answers 3


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

  • $\begingroup$ +1. slope could be made shorter: slope[s_, e_] := ArcTan @@ (e - s) $\endgroup$ Apr 19, 2013 at 13:12
  • $\begingroup$ @nikie thanks, I'll add that to the answer... $\endgroup$
    – bill s
    Apr 19, 2013 at 14:00

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

  • $\begingroup$ It works perfect ! Thanks but FindMaximum takes long time to evaluate... Do you have any other solution? $\endgroup$
    – Nam Nguyen
    May 16, 2014 at 14:08

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


Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.