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
Contour following
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 😃
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
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
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
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
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.
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...
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
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?
Make program raster2vector into a subroutine
Fill the array A with your bitmap data:
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
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)
Heavy rain it might be, but at least it is warm 1C to 3C here! Snow forecast tomorrow.
Ian
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)
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