21
$\begingroup$

I have taken several gps readings while driving around town.

gpsPositions=GeoPosition[{{33.657, -84.5197}, {33.6687, -84.4977}, 
{33.692, -84.4907}, {33.7057, -84.4287}, {33.7431, -84.4027}, {33.7285, 
-84.3493}}]

map = GeoGraphics[GeoMarker[gpsPositions], 
  GeoRange ->Entity["City",{"Atlanta","Georgia","UnitedStates"}],ImageSize->Large]

Mathematica graphics

Were are able to extract the main roads by the following functions:

    bgnd = GeoGraphics[ GeoRange ->Entity["City",{"Atlanta","Georgia","UnitedStates"}],ImageSize->Large];
    roads = DeleteSmallComponents@
      Thinning@ImageAdd[
        Dilation[#, DiskMatrix[3]] & /@ 
         DominantColors[bgnd, 7, {"CoverageImage", "Color"}][[5 ;; 6, 1]]];
    ImageCompose[map, ColorNegate@SetAlphaChannel[roads, roads]]

Mathematica graphics

Road Extraction worked fine. Now convert the gpsPositions and map them to the road image.

range = Abs[#1 - #2] & @@@ map[[8, 2]]    
origin = #1 & @@@ map[[8, 2]];
max = Reverse@ImageDimensions[roads];
waypoints = gpsPositions[[1]];
points = Reverse@(Round[(max (#)/range), 1]) & /@ ((# - origin) & /@ 
     waypoints);
Show[ColorNegate@roads, 
 Graphics[{Red, PointSize[Large], Point[points]}]]

Mathematica graphics

I would like to be able to segment the lines between the dots. Then, set up an interpolation function between each dot so we can simulate the placement of the vehicle at any point of the road as needed.

Any thoughts on how this can be achieved?

$\endgroup$
  • $\begingroup$ range appears to be undefined. $\endgroup$ – C. E. Mar 23 '15 at 22:41
20
$\begingroup$

I'm not 100% sure what you want: "segmentation" has a well-defined meaning in image processing, and I think that's not what you want. Also, I couldn't reproduce your results (I think DominantColors isn't guaranteed to give the same order or even the same results every time it's run). So this may or may not help...

First, this seems more reproducible than DominantColors:

roadColors = List @@@ {Yellow, Blue};

colorDist = 
  Total[(# - 
        Transpose[
         ImageData[bgnd][[All, All, ;; 3]], {2, 3, 1}])^2] & /@ 
   roadColors;

roads = Thinning[
  MorphologicalBinarize[
   Closing[Image[1 - MapThread[Min, colorDist, 2]], 
    DiskMatrix[3]], {0.43, 0.8}]]

Next, I convert the white pixel locations to a graph:

whitePixels = PixelValuePositions[roads, 1];

nearestFn = Nearest[whitePixels -> Automatic];

edges = MapThread[
   Function[{point, potentialNeighbors}, 
    point <-> # & /@ 
     Select[potentialNeighbors, 
      0 < EuclideanDistance[whitePixels[[#]], whitePixels[[point]]] < 
        2 &]],
   {Range[Length[whitePixels]], nearestFn[#, 10] & /@ whitePixels}];

g = Graph[DeleteDuplicates@Flatten[edges]];

Now, if I choose point locations in the image:

pts = {{133, 97}, {464, 461}};
LocatorPane[Dynamic[pts], ColorNegate@roads]

I can use nearestFn to find the nearest road pixel, and FindShortestPath to find the shortest path between two points:

path = FindShortestPath[g, nearestFn[pts[[1]]][[1]], 
   nearestFn[pts[[2]]][[1]]];

Show[Image@bgnd, 
 Graphics[{Red, Line[whitePixels[[path]]], PointSize[Large], 
   Point[whitePixels[[path[[;; ;; 10]]]]]}]]

enter image description here

We can even make a little Indiana Jones-style animation:

Animate[Show[Image@bgnd, 
  Graphics[{Red, Thick, Line[whitePixels[[path[[;; i ;; 2]]]]]}]], {i,
   1, Length[path], 1}]

(unfortunately, I don't think I can upload videos to Mathematica.SE)

$\endgroup$
  • $\begingroup$ I'm getting the error Nearest::dmtch: The dimension of... does not match when evaluating the second code block. $\endgroup$ – C. E. Mar 23 '15 at 22:43
  • $\begingroup$ @Nikie, this is what I wanted to achieve. Thx. I'll be checking the code a wee bit later. Any recommendation for changing the title to something more meaningful? $\endgroup$ – Zviovich Mar 23 '15 at 23:04
  • $\begingroup$ @Nikie, have you done anything special with the definition of bgnd? I get the following error message Show::gcomb: Could not combine the graphics objects in Show $\endgroup$ – Zviovich Mar 23 '15 at 23:58
  • 1
    $\begingroup$ @Zviovich: I've used bgnd=Image[bgnd], to make my experiments with colorDist faster. I didn't realize this changed the behavior of Show. I've updated my answer. Regarding the title: Maybe something like "Extracting road graphs from an image"? $\endgroup$ – Niki Estner Mar 24 '15 at 6:55
  • 1
    $\begingroup$ @Pickett: Weird. The documentation doesn't say that this syntax is new, and I could have sworn I've used it like this since v8. OTOH, the speed difference isn't that large (in this case) so I'll change it to your version. $\endgroup$ – Niki Estner Mar 24 '15 at 9:06

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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