Mathematica Stack Exchange is a question and answer site for users of Mathematica. Join them; it only takes a minute:

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top

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[""], .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.

share|improve this question
Have you seen this?: – Mr.Wizard Apr 19 '13 at 11:27
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:… – C. E. Apr 19 '13 at 11:33
I'm not sure either, it's just the first thing that came to mind. – Mr.Wizard Apr 19 '13 at 12:13
up vote 16 down vote accepted

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

share|improve this answer
+1. slope could be made shorter: slope[s_, e_] := ArcTan @@ (e - s) – nikie Apr 19 '13 at 13:12
@nikie thanks, I'll add that to the answer... – bill s Apr 19 '13 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

share|improve this answer
It works perfect ! Thanks but FindMaximum takes long time to evaluate... Do you have any other solution? – DaoTRINH May 16 '14 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

share|improve this answer

Your Answer


By posting your answer, you agree to the privacy policy and terms of service.

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