I'm not sure if this is even possible with Mathematica, but I want to extract the angles between all lines in this picture:
It consists of $12$ lines, so I want a matrix with $144$ entries. I really have no idea even how to begin. Any ideas?
Mathematica Stack Exchange is a question and answer site for users of Wolfram Mathematica. It only takes a minute to sign up.
Sign up to join this communityI'm not sure if this is even possible with Mathematica, but I want to extract the angles between all lines in this picture:
It consists of $12$ lines, so I want a matrix with $144$ entries. I really have no idea even how to begin. Any ideas?
I'm not experienced in image processing so don't look how I will get rid of this alpha channel or whatoever it is in your image :P
pic = Import["http://static.gulli.com/media/2009/tenenbaum/necker_wuerfel.png"];
pic2 = ImageApply[#[[4]] &, pic]
lines = ImageLines[pic2, .2, .05, "Segmented" -> True]; (*manually adjusted*)
lines // Length
12
vector = #2 - #1 & @@@ lines[[All, 1]];
angle = Outer[VectorAngle, vector, vector, 1]; (*`Tuples` earlier,
thanks to @SimonWoods*)
MatrixForm[angle] (*radians*)
MatrixForm[Round[angle/Pi, .25]] (*parts of Pi*)
Tuples
and Partition
you could use angle = Outer[VectorAngle, vector, vector, 1]
$\endgroup$
Feb 2, 2014 at 12:13
Outer
but I forgot that it will skip the partition art for us. That's why I letf Tuples
. Well, thanks, much better now. ;)
$\endgroup$
For illustrative reasons I'll show here a way to do it in raw form, starting from the Hough Transform (because it's rarely used in this site):
i = Import["http://i.stack.imgur.com/OiTnw.png"];
r = Radon[ Binarize@ColorNegate@i, Method -> "Radon"]
idr = ImageDimensions@r;
cc = Select[ComponentMeasurements[MorphologicalComponents[MaxDetect[r, .1]], "Centroid"]
[[All, 2]], #[[1]] < 9/10 First@idr &];
angles = cc[[All, 1]] Pi/First@idr
m = SparseArray[{i_, j_} :> Abs[angles[[i]] - angles[[j]]], Length@angles {1, 1}] //
MatrixForm
Edit
Following with the illustrative example, here is a way to get the lines equations:
cc2 = {#[[1]] Pi/First@idr, Rescale[#[[2]], Last@idr {0, 1},
First@ImageDimensions@i {-1, 1}]} & /@ cc
s1 = FullSimplify[ Solve[#, y] & /@ ((#[[2]] == (x Cos[#[[1]] ] + y Sin[#[[1]] ])) & /@
cc2)]
Plot[y /. s1, {x, -400, 400}, AspectRatio -> 1,
PlotRange -> {First@ImageDimensions@i {-1, 1},
Last@ImageDimensions@i {-1, 1}}]
y->267.552 +0.00199799 x
y->532.705 -1.99192 x
y->21609.1 -97.1997 x
y->13081.1 -97.1997 x
y->177.013 -1.98419 x
y->89.2196 +0.00262237 x
y->-177.013-1.98419 x
y->-89.2196+0.00262237 x
y->-13081.1-97.1997 x
y->-21609.1-97.1997 x
y->-532.705-1.99192 x
y->-267.552+0.00199799 x
The coordinates are swapped as usual in an Image/Graphics mapping.