|
forums.silverfrost.com Welcome to the Silverfrost forums
|
View previous topic :: View next topic |
Author |
Message |
aebolzan
Joined: 06 Jul 2007 Posts: 229 Location: La Plata, Argentina
|
Posted: Thu Feb 04, 2010 2:12 pm Post subject: Contour following |
|
|
Maybe this is not the right forum for my problem, but it doesn't hurt to ask I think..I have a problem processing images. I have rough quasi-circular patterns from which I have to get their contours but the points of the contours should be ordered, so that I can follow the contour from any position. The easiest way I found to get the contours is to make the image black on a white background, so that running two DO iterations one from up to down and the other from right to left of the image, I can detect the black pixels corresponding to the border of the object and get the points belonging to the contour. The only and big problem is that the points are not in order, so that I can draw the contour but I cannot "follow the contour". Do anyone know where can I find some Fortran code or algorithm that would allow me to do that? . I found that it was possible with Matlab, but its price is prohibitive for me, so I am trying to use Fortran instead..
Thanks a lot in advance!
Agustin |
|
Back to top |
|
|
jjgermis
Joined: 21 Jun 2006 Posts: 404 Location: Nürnberg, Germany
|
Posted: Fri Feb 05, 2010 8:49 am Post subject: |
|
|
Augustin, I am only familiar with finding contours used in FEA. This might be something much different that you are looking for. However, I am in the same situation with Matlab - too expesive. Lately I have discovered a new dimension of Fortran and try to achive the same results using FTN95 |
|
Back to top |
|
|
Wilfried Linder
Joined: 14 Nov 2007 Posts: 314 Location: Düsseldorf, Germany
|
Posted: Fri Feb 05, 2010 10:41 am Post subject: |
|
|
Hi Agustin, it seems that you're looking for a simple raster-to-vector converter. If you prepare a black-and-white image in which only the border lines are in black and if these lines have a thickness of one pixel then you can solve the problem very easy. Do you know the very old PC game Packman? That's the solution
Simply take a pixel, store its row-/column co-ordinates and set the pixel colour to white. Then go to the next pixel and do the same until all pixels are white.
Regards, Wilfried |
|
Back to top |
|
|
aebolzan
Joined: 06 Jul 2007 Posts: 229 Location: La Plata, Argentina
|
Posted: Sat Feb 06, 2010 2:14 am Post subject: |
|
|
Well, as far as I understand you this means that in my case I have to:
1.- Take the black on white background bmp image of the surface I want to determine its contour and searching from up to down and right to left, find the points that are at the edge of the surface.
2.- with these points I have to create a new bmp image showing the black border line of the object
3.- then I take a first point of the line, store its x-y coordinates and turn its colour from black to white
4.- then I checkl where is the next black point, store its coordinates, change its colour and go on...
If am I right, I will check this procedure, but I do not get how you can detect that the point you are making white is linked with, for instance, the point below and not with the point at the left. For instance if you have something like this: |_| you start with the point top left...the connection is evidently top left to down left, but if you move top right you also find a black point. Or am I wrong?
Regards
Agustin |
|
Back to top |
|
|
Wilfried Linder
Joined: 14 Nov 2007 Posts: 314 Location: Düsseldorf, Germany
|
Posted: Sat Feb 06, 2010 11:29 am Post subject: |
|
|
1.- right
2.- right, but make sure that the line has a width of exactly one pixel
3.- right
4.- right
The problem you mentioned depends on the form of the object. In an optimal case it is convex (best: circle-shaped), and then this algorithm will work. But if you have for instance an asterisk-shaped object, you will get problems.
Regards, Wilfried |
|
Back to top |
|
|
aebolzan
Joined: 06 Jul 2007 Posts: 229 Location: La Plata, Argentina
|
Posted: Sat Feb 06, 2010 6:24 pm Post subject: |
|
|
the object is the fractal contour of a colony of cells, so that rather irregular like the contour of the British Islands....so I would say that is nearer to the "asterisk" than to a convex or circle shaped object. Uhmm I guess.....I will get problems as you say....because the direction of the contour line change its direction erratically.......
Agustin |
|
Back to top |
|
|
IanLambley
Joined: 17 Dec 2006 Posts: 490 Location: Sunderland
|
Posted: Sun Feb 07, 2010 12:14 pm Post subject: |
|
|
Agustin
I googled the problem and came up with the following link:
http://cardhouse.com/computer/vector.htm
I've converted it from Pascal to Fortran, but not tested it and there is an alternate subroutine available I assume that A needs to be filled with the black and white bitmap, set actualx and actualy to the bitmap size and the routine called.
Use get_dib_size@ & get_dib_block@ to fill the array.
After that I have no idea.
Code: |
winapp
module v2rast
type vector
integer*4:: charnum
integer*4:: prev
integer*4:: sx,sy
integer*4:: ex,ey
integer*4:: next
integer*4:: status
end type vector
end module v2rast
program raster2vector
use v2rast
parameter (MAXSIZEX = 32768,MAXSIZEY = 32768, maxvector = 1000)
integer*4:: A, Vnum,actualx,actualy
type (vector) V
common /r2v/vnum,a(1:MAXSIZEX,1:MAXSIZEY),V(1:maxvector),actualx,actualy
vnum = 0
call procvector
call simplifyvector
call lengthenvector
end
subroutine addsquarevector(j,k)
use v2rast
parameter (MAXSIZEX = 32768,MAXSIZEY = 32768, maxvector = 1000)
integer*4:: A, Vnum,actualx,actualy
type (vector) V
common /r2v/vnum,a(1:MAXSIZEX,1:MAXSIZEY),V(1:maxvector),actualx,actualy
integer*4:: j,k
Vnum = Vnum + 1
V(Vnum)%prev = Vnum + 3
V(Vnum)%sx = j
V(Vnum)%sy = k
V(Vnum)%ex = j + 1
V(Vnum)%ey = k
V(Vnum)%next = Vnum + 1
V(Vnum)%status = 0
Vnum = Vnum + 1
V(Vnum)%prev = Vnum - 1
V(Vnum)%sx = j + 1
V(Vnum)%sy = k
V(Vnum)%ex = j + 1
V(Vnum)%ey = k + 1
V(Vnum)%next = Vnum + 1
V(Vnum)%status = 0
Vnum = Vnum + 1
V(Vnum)%prev = Vnum - 1
V(Vnum)%sx = j + 1
V(Vnum)%sy = k + 1
V(Vnum)%ex = j
V(Vnum)%ey = k + 1
V(Vnum)%next = Vnum + 1
V(Vnum)%status = 0
Vnum = Vnum + 1
V(Vnum)%prev = Vnum - 1
V(Vnum)%sx = j
V(Vnum)%sy = k + 1
V(Vnum)%ex = j
V(Vnum)%ey = k
V(Vnum)%next = Vnum - 3
V(Vnum)%status = 0
Vnum = Vnum
end
subroutine procvector
use v2rast
parameter (MAXSIZEX = 32768,MAXSIZEY = 32768, maxvector = 1000)
integer*4:: A, Vnum,actualx,actualy
type (vector) V
common /r2v/vnum,a(1:MAXSIZEX,1:MAXSIZEY),V(1:maxvector),actualx,actualy
integer*4:: j,k
Vnum = 0
do j = 1 , actualx !// no, what is x setting?
do k = 1 , actualy !// no what is y setting?
if (a(j,k) == 1) then
call addsquarevector(j,k)
endif
enddo
enddo
end
subroutine removevector(mm,mm2)
use v2rast
parameter (MAXSIZEX = 32768,MAXSIZEY = 32768, maxvector = 1000)
integer*4:: A, Vnum,actualx,actualy
type (vector) V
common /r2v/vnum,a(1:MAXSIZEX,1:MAXSIZEY),V(1:maxvector),actualx,actualy
integer*4:: p,n,mm,mm2
p = V(mm)%prev
V(p)%next = V(mm2)%next
n = V(mm2)%next
V(n)%prev = p
end
subroutine removevectors(m,m2 )
use v2rast
parameter (MAXSIZEX = 32768,MAXSIZEY = 32768, maxvector = 1000)
integer*4:: A, Vnum,actualx,actualy
type (vector) V
common /r2v/vnum,a(1:MAXSIZEX,1:MAXSIZEY),V(1:maxvector),actualx,actualy
integer*4:: m,m2
call removevector(m,m2)
call removevector(m2,m)
! // lastly etch out the unneeded vectors.
V(m)%status = -1
V(m2)%status = -1
end
|
continued... |
|
Back to top |
|
|
IanLambley
Joined: 17 Dec 2006 Posts: 490 Location: Sunderland
|
Posted: Sun Feb 07, 2010 12:15 pm Post subject: |
|
|
Code: |
logical*4 function equalpoints(p1x,p1y,p2x,p2y)
integer*4:: p1x,p1y,p2x,p2y
equalpoints = ((p1x == p2x) .and. (p1y == p2y))
end
logical*4 function equalvectors(m,m2)
use v2rast
parameter (MAXSIZEX = 32768,MAXSIZEY = 32768, maxvector = 1000)
integer*4:: A, Vnum,actualx,actualy
type (vector) V
common /r2v/vnum,a(1:MAXSIZEX,1:MAXSIZEY),V(1:maxvector),actualx,actualy
integer*4:: m,m2
integer*4:: msx,msy,mex,mey,m2sx,m2sy,m2ex,m2ey
logical*4 :: r,equalpoints
r = .false.
if (V(m)%status .ne. -1) then
msx = V(m)%sx
msy = V(m)%sy
mex = V(m)%ex
mey = V(m)%ey
m2sx = V(m2)%sx
m2sy = V(m2)%sy
m2ex = V(m2)%ex
m2ey = V(m2)%ey
if (equalpoints(msx,msy,m2sx,m2sy) .and. &
equalpoints(mex,mey,m2ex,m2ey)) then
r = .true.
elseif (equalpoints(msx,msy,m2ex,m2ey) .and. &
equalpoints(mex,mey,m2sx,m2sy)) then
r = .true.
endif
endif
equalvectors = r
end
!// grab each vector in list. If it is the same as any other vector,
!// get rid of it.
subroutine simplifyvector
use v2rast
parameter (MAXSIZEX = 32768,MAXSIZEY = 32768, maxvector = 1000)
integer*4:: A, Vnum,actualx,actualy
type (vector) V
common /r2v/vnum,a(1:MAXSIZEX,1:MAXSIZEY),V(1:maxvector),actualx,actualy
integer*4:: m,m2
logical*4 :: equalvectors
do m = 1 , Vnum
do m2 = m + 1 , Vnum
if (equalvectors(m,m2)) then
call removevectors(m,m2)
endif
enddo
enddo
end
subroutine lengthenvector
use v2rast
parameter (MAXSIZEX = 32768,MAXSIZEY = 32768, maxvector = 1000)
integer*4:: A, Vnum,actualx,actualy
type (vector) V
common /r2v/vnum,a(1:MAXSIZEX,1:MAXSIZEY),V(1:maxvector),actualx,actualy
integer*4:: m
! // now we have vectors, but some vectors have multiple points.
! // so let's turn two vectors into one longer vector. Okay? Okay!
do m = 1 , Vnum
if ((V(m)%prev .ne. 0) .and. (V(m)%status .gt. -1)) then
if ((V(V(m)%prev)%sx == V(m)%ex) .or. &
(V(V(m)%prev)%sy == V(m)%ey)) then
V(V(m)%prev)%ex = V(m)%ex
V(V(m)%prev)%ey = V(m)%ey
V(V(m)%prev)%next = V(m)%next
V(V(m)%next)%prev = V(m)%prev
V(m)%status = -1
endif
endif
enddo
end
subroutine lengthenvector_alternate
use v2rast
parameter (MAXSIZEX = 32768,MAXSIZEY = 32768, maxvector = 1000)
integer*4:: A, Vnum,actualx,actualy
type (vector) V
common /r2v/vnum,a(1:MAXSIZEX,1:MAXSIZEY),V(1:maxvector),actualx,actualy
integer*4:: m
! // now we have vectors, but some vectors have multiple points.
! // so let's turn two vectors into one longer vector. Okay? Okay!
do m = 1 , Vnum
if ((V(m)%prev .ne. 0) .and. (V(m)%status .gt. -1)) then
if ((V(V(m)%prev)%ex == V(m)%sx) .or. &
(V(V(m)%prev)%ey == V(m)%sy)) then
V(V(m)%prev)%ex = V(m)%ex
V(V(m)%prev)%ey = V(m)%ey
V(V(m)%prev)%next = V(m)%next
V(m)%status = -1
endif
endif
enddo
end
|
Good luck
Ian |
|
Back to top |
|
|
jjgermis
Joined: 21 Jun 2006 Posts: 404 Location: Nürnberg, Germany
|
Posted: Sun Feb 07, 2010 1:05 pm Post subject: |
|
|
I always like some example code. Anyway, I compiled the code without any problems. One do need some example or bitmap with the code - is that correct? The website mentioned in the previous post is interesting, but I am to lazy to read through all the text to see whether there is an example. What do I need to "activate" the prpogram? |
|
Back to top |
|
|
IanLambley
Joined: 17 Dec 2006 Posts: 490 Location: Sunderland
|
Posted: Sun Feb 07, 2010 3:55 pm Post subject: |
|
|
1. Make program raster2vector into a subroutine
2. Fill the array A with your bitmap data:
Code: |
integer*4:: A, Vnum,actualx,actualy
type (vector) V
common /r2v/vnum,a(1:MAXSIZEX,1:MAXSIZEY),V(1:maxvector),actualx,actualy
INTEGER*4:: NBBP, ERCODE
call GET_DIB_SIZE@( 'myfile.bmp', actualx, actualy , NBBP, ERCODE )
if(ercode .eq. 0)then
call GET_DIB_BLOCK@( 'myfile.bmp',A, MAXSIZEX , MAXSIZEY , 0,0, actualx, actualy , 0, 0, ERCODE )
if(ercode .eq. 0)then
call raster2vector
endif
endif
|
Have a look in the vector data V and this should contain the contour. Maybe even in continuous order if you are lucky!
Regards
Ian |
|
Back to top |
|
|
aebolzan
Joined: 06 Jul 2007 Posts: 229 Location: La Plata, Argentina
|
Posted: Sun Feb 07, 2010 5:19 pm Post subject: |
|
|
Thanks Ian for your interest in my problem. I will implement your code and check if it is the solution I am looking for. Thanks a lot.
Agustin (from a heavy rainy La Plata) |
|
Back to top |
|
|
IanLambley
Joined: 17 Dec 2006 Posts: 490 Location: Sunderland
|
Posted: Mon Feb 08, 2010 12:02 pm Post subject: |
|
|
Heavy rain it might be, but at least it is warm 1C to 3C here! Snow forecast tomorrow.
Ian |
|
Back to top |
|
|
aebolzan
Joined: 06 Jul 2007 Posts: 229 Location: La Plata, Argentina
|
Posted: Mon Feb 08, 2010 7:52 pm Post subject: |
|
|
Sorry, Ian, but I am testing your code and get some errors such as access violation when getting the DIB block. After carefully looking I see that you define "a" as integer*4, but according to the manual, "a" should be a character array of three dimensions:
SUBROUTINE GET_DIB_BLOCK@( FILENAME, PARRAY, AW, AH, ADX,
+ ADY, W, H, DX, DY, ERCODE )
CHARACTER*(*) FILENAME
CHARACTER PARRAY(3,AW,AH)
INTEGER AW,AH,ADX,ADY,W,H,DX,DY,ERCODE
Am I missing anything?
Best regards,
Agustin (today from sunny La Plata and 28 C) |
|
Back to top |
|
|
IanLambley
Joined: 17 Dec 2006 Posts: 490 Location: Sunderland
|
Posted: Tue Feb 09, 2010 12:00 am Post subject: |
|
|
Hi,
The code must have been written to use a rgb value which takes 3 bytes to define, but stored in a four byte value, i.e integer*4.
You should be able to define the parray as:
integer*1 parray(3,aw,ah)
You need to turn the bitmap into a black and white image and set each element of A to zero or 1 as appropriate, based on the three values for each pixel in parray. You can use the rgb@ to convert the three individual values to a single integer*4 to help with the comparison.
I hope this helps.
Ian |
|
Back to top |
|
|
|
|
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|